ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ¶µ¬Û¤ÀÃþ­«¾ã

[µo°Ý] ¶µ¬Û¤ÀÃþ­«¾ã

¦U¦ì¤j¤j,

½Ð°Ý§Ú¦³¤@­ÓÁ`±b¬O©Ò¦³¸ê®Æ³£Âk¯Ç¦b¤@­Ó¤u§@ªí, ¦ý§Ú·Q«ö·Ó¤£¦Pªº½s¸¹(¬A¸¹¤ºªº¼Æ¦r)½Æ»s¦b¥t¤@¤u§@ªí©M¥[¤W©T©wªº¶µ¥Ø¦Wµ¥ºÙ, ¨C¤@­Ó¬ì¥Ø¤§¶¡³£·|¦³¤@¦æªÅ¶¡¬Û¹j,

ÁÂÁÂ

¤ÀÃþ±b.rar (124.42 KB)

¦^´_ 1# mdr0465


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨ÒÀÉ
«á¾Ç¬ã¨s¹L¥H¤U³sµ²©«¤ñ³o©«½ÆÂø,½Ð«e½ú¬ã¨s¬Ý¬Ý
http://forum.twbts.com/viewthrea ... a=pageD3&page=1
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2022-12-22 16:47 ½s¿è

¦^´_ 1# mdr0465


    ¯¬¦U¦ì«e½ú ¥V¦Ü¥­¦w³ß¼Ö
«á¾Ç¤µ¤Ñ¥ð°²,Á{®É³Q¥l¦^³B¸Ì¨Æ±¡,¬Ý¤F¤@¤U³o©«
¬Q¤Ñ¦³¬ã¨s¤F«e½ú»Ý¨D±¡¹Ò,¤µ¤Ñ´ú¸Õ¤F¤@¤U,¥ý´£¨Ñµ¹«e½ú¸Õ¸Õ¬Ý,¬O§_²Å¦X»Ý¨D
¥ý¦^®a¤F,«e½úªº¯d¨¥©ú¤Ñ¤~¯à¦^´_
½Ð«e½ú­Ì«ü¾É

°õ¦æµ²ªG:


Option Explicit
Sub ¶µ¬Û¤ÀÃþ­«¾ã_20221222_1()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim Arr, i&, j&, Brr, Y, N, Ra, Sh
Set Y = CreateObject("Scripting.Dictionary")
Set Sh = Sheets("µ²ªG")
Arr = Range([¤ÀÃþ±b!H1], [¤ÀÃþ±b!A1].Cells(Rows.Count, 1).End(xlUp))
With Sheets.Add
   With .[A1].Resize(UBound(Arr), UBound(Arr, 2))
      .Value = Arr
      .Sort _
      KEY1:=.Item(1), Order1:=xlAscending, _
      Key2:=.Item(2), Order2:=xlAscending, _
      Header:=xlYes, Orientation:=xlTopToBottom
       Arr = .Value
   End With
   .Delete
End With
For i = 1 To UBound(Arr)
   Y(Arr(i, 1)) = ""
Next
ReDim Brr(1 To UBound(Arr) + Y.Count * 3, 1 To UBound(Arr, 2))
Set Ra = Sh.[A1:H1]
For i = 2 To UBound(Arr)
   If Arr(i, 1) <> Arr(i - 1, 1) Then
      N = IIf(i = 2, N + 1, N + 2)
      Set Ra = Union(Ra, Range(Sh.Cells(N, 1), Sh.Cells(N, 8)))
      Brr(N, 2) = Arr(i, 1)
      N = N + 1
      Set Ra = Union(Ra, Range(Sh.Cells(N, 1), Sh.Cells(N, 8)))
      For j = 1 To UBound(Arr, 2)
         Brr(N, j) = Arr(1, j)
      Next
   End If
   
111
   N = N + 1
   Set Ra = Union(Ra, Range(Sh.Cells(N, 1), Sh.Cells(N, 8)))
   For j = 1 To UBound(Arr, 2)
      Brr(N, j) = Arr(i, j)
   Next
   Brr(N, 2) = "'" & Format(Brr(N, 2), "yyyy-mm-dd")
   Brr(N, 3) = "'" & Brr(N, 3)
Next
Sh.UsedRange.ClearContents
Sh.Cells.Borders.LineStyle = 0
Ra.Borders.LineStyle = 1
Sh.[A1].Resize(UBound(Brr), UBound(Brr, 2)) = Brr
Set Y = Nothing
Set Arr = Nothing
Set Brr = Nothing
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 3# Andy2483

Andy®v¥S,§A¦n

ÁÂÁ§AªºÀ°¦£
³o¥¿¬O§Ú·Q­nªºµ²ªG,¦ý¥i¤£¥i¥H¦A­×§ï¤@¨Ç¤º®e, §Ú·Q±N©Ò¦³ªº" ¥»¤é¦X­p" ©M"¥»¦~²Ö­p" ³£§R°£,ÁÂÁÂÀ°¦£­×§ïµ{¦¡

,

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2022-12-23 09:11 ½s¿è

¦^´_ 4# mdr0465


    ÁÂÁ«e½ú¦^´_
¤µ¤Ñ½Æ²ß­×§ï¤F¤@¤U,½Ð«e½ú¦A¸Õ¸Õ¬Ý,¤ß±oµù¸Ñ½Ð°Ñ¦Ò
½Ð¦U¦ì«e½ú«ü¾É,ÁÂÁÂ

°õ¦æµ²ªG:


Option Explicit
Sub ¶µ¬Û¤ÀÃþ­«¾ã_20221222_1()
Application.DisplayAlerts = False
'¡ô¤£­n°Ý¬O¤£¬O¯uªº­n§R°£¤u§@ªí!°®¯ÜÂI!
Application.ScreenUpdating = False
'¡ô¿Ã¹õ¤£­n¸òµÛµ{§Ç°µÅܤÆ!°½°½°µ´N¦n¤F
Dim i&, j&, N&, St$, Arr, Brr, Y, Z, Ra, Sh
'¡ô«Å§iÅܼÆ:(i,j,N)¬Oªø¾ã¼ÆÅܼÆ,St¬O¦r¦êÅܼÆ,¨ä¥L¬O³q¥Î«¬ÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
Set Z = CreateObject("Scripting.Dictionary")
'¡ô¥OY,Z¦U¬O ¦r¨å
Set Sh = Sheets("µ²ªG")
'¡ô¥OSh¬O "µ²ªG"¤u§@ªí
Arr = Range([¤ÀÃþ±b!H1], [¤ÀÃþ±b!A1].Cells(Rows.Count, 1).End(xlUp))
'¡ô¥OArr¬O ¤Gºû°}¦C!­Ë¤J±q "¤ÀÃþ±b"¤u§@ªíªº[H1]¨ì¸ÓªíªºAÄæ³Ì«á¤@­Ó¦³¤º®eÀx¦s®æ¤§¶¡,
'ÂX®i¦¨¬°³Ì¤p¤è¥¿°Ï°ìÀx¦s®æªº­È

With Sheets.Add
'¡ô¥H¤U¬O¦³Ãö©ó·s¼W¤u§@ªíªºµ{§Ç
   With .[A1].Resize(UBound(Arr), UBound(Arr, 2))
   '¡ô¥H¤U¬O¦³Ãö©ó·s¼W¤u§@ªí±q[A1]ÂX®iÁa¦VArr°}¦C³Ì¤j¦C¸¹¼Æ,¾î¦VArr°}¦C³Ì¤jÄ渹¼Æ,
   '³o¨ÇÀx¦s®æªºµ{§Ç

      .Value = Arr
      '¡ôÀx¦s®æ­È¥H Arr°}¦C­È­Ë¶i¥h
      .Sort _
      KEY1:=.Item(1), Order1:=xlAscending, _
      Key2:=.Item(2), Order2:=xlAscending, _
      Header:=xlYes, Orientation:=xlTopToBottom
      '¡ô¥O¥H²Ä1Äæ°µ²Ä¤@¼h°µ¦³¼Ð¦Cªº¤W¤U¶¶±Æ§Ç,²Ä2Äæ¦P®É°µ²Ä¤G¼h¤W¤U¶¶±Æ§Ç
      Arr = .Value
      '¡ô¥OArr°}¦C­Ë±¼­ì¨Óªº­È,¸Ë¤J³o±Æ§Ç¦nªºÀx¦s®æ­È
   End With
   .Delete
   '¡ô¥O³o·s¼W¤u§@ªí§R°£
End With
'§Ú·Q±N©Ò¦³ªº" ¥»¤é¦X­p" ©M"¥»¦~²Ö­p" ³£§R°£
St = "/¥»¤é¦X­p/¥»¦~²Ö­p/ÃöÁä¦r|/ÃöÁä¦r|/"
'¡ô¥OSt³o¦r¦êÅܼƬOÂù¤Þ¸¹¸Ìªº³o¨Ç¦r,ÃöÁä¦r|¬O¥Î¨Óµ¹¨Ï¥ÎªÌ°l¥[ªº
For i = 1 To UBound(Arr)
'¡ô³]¶¶°j°é!i±q1¨ìArr°}¦C³Ì¤j¦C¸¹¼Æ
   Y(Arr(i, 1)) = ""
   '¡ô¥O¥H°j°é¦C²Ä1ÄæArr°}¦C­È·íkey,item¬OªÅ¦r¤¸,©ñ¤JY¦r¨å¸Ì,
   '³o¬O­n²Î­p¦@¦³´XºØ ©ú²Ó¬ì¥Ø,¤~ª¾¹D­n¼W¥[¦h¤Ö¼ÐÃD¦C

   If InStr(St, "/" & Replace(Arr(i, 4), " ", "") & "/") <> 0 Then
   '¡ô¦pªG¥ÎInStr()¨ç¦¡§PÂ_¬O¤£µ¥©ó 0,«ç»ò§PÂ_?
   '¥ý¥ÎReplace()¨ç¦¡±Ni°j°é¦C²Ä4ÄæArr°}¦C­È,¥Î""ªÅ¦r¤¸¸m´«±¼" "ªÅ¥Õ¦r¤¸,
   '¦A¥Î"/"²Å¸¹¦b«e«á¥]¦í³o¦r¦ê,¥H§K»~§P
   '¥h¤ñ¹ïSt¦r¦êÅܼƸ̦³¨S¦³¥]§t³o¦ê¦r

'https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/instr-function
      Z("¦X­p²Ö­p") = Z("¦X­p²Ö­p") + 1
      '¡ô¥O¥H"¦X­p²Ö­p"¦r¦ê·íkey,item²Ö¥[ 1
   End If
Next
ReDim Brr(1 To UBound(Arr) + Y.Count * 3 - 1 - Z("¦X­p²Ö­p"), 1 To UBound(Arr, 2))
'¡ô«Å§iBrr°}¦Cªº½d³ò¤j¤p,Áa¦V±q1¨ìArr°}¦C³Ì¤j¯Á¤Þ¦C¸¹¼Æ+Y¦r¨åkey¼Æ¶q*3,´î1,
'¦A´î±¼ "¦X­p²Ö­p"¦r¦ê·íkey¬dZ¦r¨å±o¨ìªºitem­È
'¾î¦V±q1¨ìArr°}¦C³Ì¤j¯Á¤ÞÄ渹¼Æ

Set Ra = Sh.[A1:H1]
'¡ô¥ORa³o³q¥Î«¬ÅܼƬO Sh¤u§@ªíÅܼƸ̪º[A1:H1]Àx¦s®æ
For i = 2 To UBound(Arr)
'¡ô³]¥~¶¶°j°é!i±q2¨ìArr°}¦C³Ì¤j¦C¸¹¼Æ
   If Arr(i, 1) <> Arr(i - 1, 1) Then
   '¡ô¦pªGi°j°é¦C²Ä1ÄæArr°}¦C­È ¤£µ¥©ó(i-1)°j°é¦C²Ä1ÄæArr°}¦C­È
      N = IIf(i = 2, N + 1, N + 2)
      '¡ô¥ON³oªø¾ã¼ÆÅܼƪº­È¥Î IIf()¨ç¦¡¨M©w,
      '¦pªGi°j°é¼Æ¬O 2®ÉN = N + 1,§_«hN = N + 2

      Set Ra = Union(Ra, Range(Sh.Cells(N, 1), Sh.Cells(N, 8)))
      '¡ô¥ORa³o³q¥Î«¬ÅܼƥÎUnion()¨ç¦¡ ²Ö¿nÀx¦s®æ¶°,
      '³W«h¬ORa¦Û¨­ ¦A¥[¤J ±q"µ²ªG"¤u§@ªí N¦C²Ä1ÄæÀx¦s®æ¨ì ¸ÓªíN¦C²Ä8ÄæÀx¦s®æ,
      '³o¨â®æ¤§¶¡ªº©Ò¦³Àx¦s®æ

      Brr(N, 2) = Arr(i, 1)
      '¡ô¥ONÅܼƦC²Ä2ÄæBrr°}¦C­È¬O i°j°é¦C²Ä1ÄæArr°}¦C­È (©ú²Ó¬ì¥Ø)
      N = N + 1
      '¡ô¥ON³oªø¾ã¼ÆÅܼÆX²Ö¥[ 1 (¥[1¦C)
      Set Ra = Union(Ra, Range(Sh.Cells(N, 1), Sh.Cells(N, 8)))
      '¡ô¦P¤W
      For j = 1 To UBound(Arr, 2)
      '¡ô³]¤º¶¶°j°é!j±q1¨ìArr°}¦C³Ì¤jÄ渹¼Æ
         Brr(N, j) = Arr(1, j)
         '¡ô¥ONÅܼƦC²Äj°j°éÄæBrr°}¦C­È¬O ²Ä1¦C²Äj°j°éÄæArr°}¦C­È
      Next
   End If
   If InStr(St, "/" & Replace(Arr(i, 4), " ", "") & "/") <> 0 Then
   '¡ô¦P¤W
      GoTo Hi
      '¡ô´N¥h§ä Hi
   End If
   N = N + 1
   '¡ô¦P¤W
   Set Ra = Union(Ra, Range(Sh.Cells(N, 1), Sh.Cells(N, 8)))
   '¡ô¦P¤W
   For j = 1 To UBound(Arr, 2)
   '¡ô¦P¤W
      Brr(N, j) = Arr(i, j)
      '¡ô¥ONÅܼƦC²Äj°j°éÄæBrr°}¦C­È¬O ²Äi°j°é²Äj°j°éÄæArr°}¦C­È
   Next
   Brr(N, 2) = "'" & Format(Brr(N, 2), "yyyy-mm-dd")
   '¡ô¥ONÅܼƦC²Ä2ÄæBrr°}¦C­È¬O"'" ²Å¸¹³s±µ¦Û¨­¤é´ÁÂର¦r¦ê,
   '¥H"yyyy-mm-dd"¤è¦¡§e²{

   Brr(N, 3) = "'" & Brr(N, 3)
   '¡ô¥ONÅܼƦC²Ä3ÄæBrr°}¦C­È¬O"'" ²Å¸¹³s±µ¦Û¨­
Hi:
'Hi¦b³o¸Ì
Next
Sh.UsedRange.ClearContents
'¡ô¥OShÅܼƤu§@ªí¦³¨Ï¥ÎªºÀx¦s®æ³Ì¤p¤è¥¿°Ï°ìÀx¦s®æ¤º®e²M°£
Sh.Cells.Borders.LineStyle = 0
'¡ô¥OShÅܼƤu§@ªí¥þ³¡ªº®æ½u³£¤£­n
Ra.Borders.LineStyle = 1
'¡ô¥ORa³oÀx¦s®æ¶°ªº®æ½u¬O ²Ó¹ê½u
Sh.[A1].Resize(UBound(Brr), UBound(Brr, 2)) = Brr
'¡ô¥OShÅܼƤu§@ªí±q[A1]ÂX®iÁa¦V:Brr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹¼Æ,
'¾î¦V:Brr°}¦C¾î¦V³Ì¤j¯Á¤ÞÄ渹¼Æ,³o½d³òÀx¦s®æ¥H Brr°}¦C­È­Ë¤J
'§¹¤u¤F

Set Y = Nothing
Set Z = Nothing
Set Arr = Nothing
Set Brr = Nothing
'¤u¨ã®e¾¹­n¦¬¤@¦¬,ÄÀ©ñ±¼ÅܼÆ
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 5# Andy2483

Andy®v¥S,
¸U¤À·PÁ§AªºÀ°¦£©M¸Ô²Óªº¸ÑŪ, ÁÂÁ§A

TOP

¦^´_ 5# Andy2483
¸Õ¸Õ¶i¶¥¿z¿ï
  1. Option Explicit
  2. Dim Rng(1 To 5) As Range
  3. Sub ¶µ¬Û¤ÀÃþ­«¾ã()
  4.     ³]©w
  5.     ¶i¶¥¿z¿ï
  6. End Sub
  7. Private Sub ³]©w()
  8.     Set Rng(1) = Sheets("¤ÀÃþ±b").Range("A1").CurrentRegion
  9.     With Sheets("µ²ªG")
  10.         .Cells.Clear
  11.         Set Rng(2) = .[Z1]   '¦s©ñ©ú²Ó¬ì¥Ø_¹ô§OÄd ¤£­«´_ªº¶µ¥Ø
  12.         Set Rng(5) = .[A1]  '¦s©ñ¨C¦¸¿z¿ïªº¦ì¸m
  13.     End With
  14.     Rng(1).Range("A1").Copy Rng(2)
  15.     Rng(1).AdvancedFilter xlFilterCopy, Rng(2).Cells.Resize(2), Rng(2), True ' "©ú²Ó¬ì¥Ø_¹ô§O"¿z¿ï¤£­«´_ªº¶µ¥Ø
  16.     Set Rng(3) = Rng(2).Offset(, 1)                 '¿z¿ïªº·Ç«h½d³ò
  17.      Rng(1).Range("A1,D1").Copy Rng(3)    '·Ç«hªºÄæ¦ì
  18.     Set Rng(4) = Rng(3).Offset(, 3)                 '«ü©w³Q½Æ»s¦Cªº¥Ø¼Ð½d³ò
  19. End Sub
  20. Private Sub ¶i¶¥¿z¿ï()
  21.     Dim i As Integer, R As Range
  22.     Rng(3).Range("B2") = "=" & """<>" & "    ¥» ¤é ¦X ­p"""                         '¶ñ[ºK­n]¤J·Ç«h ±ø¥ó
  23.     i = 2
  24.     Do While Rng(2).Cells(i) <> ""
  25.         Rng(4).CurrentRegion.Clear
  26.         Rng(3).Range("A2") = Rng(2).Cells(i)                                                        '¶ñ¤J[©ú²Ó¬ì¥Ø_¹ô§O]·Ç«h±ø¥ó
  27.         Rng(1).AdvancedFilter xlFilterCopy, Rng(3).Resize(2, 2), Rng(4)      '¶i¶¥¿z¿ï'
  28.         Rng(5) = Rng(2).Cells(i).Value                                                                     '¼ÐÀY ¿z¿ïªº[©ú²Ó¬ì¥Ø_¹ô§O]
  29.         Rng(4).CurrentRegion.Offset(, 1).Copy Rng(5).Offset(1)                   '¸ê®Æªº½d³ò .Offset(, 1) ¦V¥k²¾°Ê¤@Äd **¤£»Ý­n [©ú²Ó¬ì¥Ø_¹ô§O]Äæ
  30.         Set Rng(5) = Rng(5).End(xlDown).Offset(2)
  31.         i = i + 1
  32.     Loop
  33. End Sub
½Æ»s¥N½X

TOP

¦^´_ 7# lee88


    ÁÂÁ«e½ú«ü¾É
«á¾Ç¬O¿ý»s¥¨¶°¾Ç°_ªº,³£¥H²´¨£¬°¾Ì­×§ï¥¨¶°¥H²Å¦X»Ý¨D,¤£ª¾¹D¥i¥H³o¼Ë¹B¥Î
¥ýÁÂÁ«e½ú«ü¾É,«á¾Ç¨Ì´`«e½úµù¸Ñ¬ã¨s¬Ý¬Ý
°õ¦æµ²ªG:
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 7# lee88


    ÁÂÁ«e½ú«ü¾É
«á¾Ç¤µ¤Ñ½m²ß±NRng(1 To 5) As Range ¥ÎY¦r¨å¸Ë²±

°õ¦æµ²ªG:


»²§UÄæ:


Option Explicit
Sub ¶µ¬Û¤ÀÃþ­«¾ã_20221229_1()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim i&, Y
Set Y = CreateObject("Scripting.Dictionary")
Set Y(1) = Sheets("¤ÀÃþ±b").Range("A1").CurrentRegion
With Sheets("µ²ªG")
   .Cells.Clear
   Set Y(2) = .[Z1]
   '¦s©ñ©ú²Ó¬ì¥Ø_¹ô§OÄd ¤£­«´_ªº¶µ¥Ø
   Set Y(5) = .[A1]
   '¦s©ñ¨C¦¸¿z¿ïªº¦ì¸m
End With
Y(1).Range("A1").Copy Y(2)
Y(1).AdvancedFilter xlFilterCopy, Y(2).Cells.Resize(2), Y(2), True
' "©ú²Ó¬ì¥Ø_¹ô§O"¿z¿ï¤£­«´_ªº¶µ¥Ø
Set Y(3) = Y(2).Offset(, 1)
'¿z¿ïªº·Ç«h½d³ò
Y(1).Range("A1,D1").Copy Y(3)
'·Ç«hªºÄæ¦ì
Set Y(4) = Y(3).Offset(, 3)
'«ü©w³Q½Æ»s¦Cªº¥Ø¼Ð½d³ò
Y(3).Range("B2") = "=" & """<>" & "    ¥» ¤é ¦X ­p"""
'¶ñ[ºK­n]¤J·Ç«h ±ø¥ó
i = 2
Do While Y(2).Cells(i) <> ""
   Y(4).CurrentRegion.Clear
   Y(3).Range("A2") = Y(2).Cells(i)
   '¶ñ¤J[©ú²Ó¬ì¥Ø_¹ô§O]·Ç«h±ø¥ó
   Y(1).AdvancedFilter xlFilterCopy, Y(3).Resize(2, 2), Y(4)
   '¶i¶¥¿z¿ï'
   Y(5).Value = Y(2).Cells(i).Value
   '¼ÐÀY ¿z¿ïªº[©ú²Ó¬ì¥Ø_¹ô§O]
   Y(4).CurrentRegion.Offset(, 1).Copy Y(5).Offset(1)
   '¸ê®Æªº½d³ò .Offset(, 1) ¦V¥k²¾°Ê¤@Äd **¤£»Ý­n [©ú²Ó¬ì¥Ø_¹ô§O]Äæ
   Set Y(5) = Y(5).End(xlDown).Offset(2)
   i = i + 1
Loop
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 9# Andy2483
¥i·b¼¯¤@¤U
  1. Option Explicit
  2. Sub TEST()
  3. Dim Sh As Worksheet, Rng As Range, i As Integer
  4.     Set Sh = Sheets("¤ÀÃþ±b")
  5.     With Sheets("µ²ªG")
  6.         .Cells.Clear
  7.         Set Rng = .[a1]
  8.         Sh.Range("A:A").AdvancedFilter xlFilterCopy, , .[Z1], True  '
  9.          Sh.Range("A1,d1").Copy .[aa1]
  10.         .[ab2] = "=" & """<>" & "    ¥» ¤é ¦X ­p"""                        '¶ñ[ºK­n]¤J·Ç«h ±ø¥ó
  11.         i = 2
  12.         Do While .[Z1].Cells(i) <> ""
  13.             .Range("aa2," & Rng.Address) = .[Z1].Cells(i)            '
  14.             Sh.Range("B1:H1").Copy Rng.Cells(2)
  15.             Sh.Range("a:H").AdvancedFilter xlFilterCopy, .[aa1:ab2], Rng.Cells(2).Resize(1, 7)    '¶i¶¥¿z¿ï'
  16.             Set Rng = Rng.End(xlDown).Offset(2)         
  17.             i = i + 1
  18.         Loop
  19.     End With
  20. End Sub
½Æ»s¥N½X

TOP

        ÀR«ä¦Û¦b : «Î¼e¤£¦p¤ß¼e¡C
ªð¦^¦Cªí ¤W¤@¥DÃD