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

[µo°Ý] ¬°¦ó¥u§ì¨ì²Ä¤@µ§¸ê®Æ

[µo°Ý] ¬°¦ó¥u§ì¨ì²Ä¤@µ§¸ê®Æ

¥u§ì¨ì²Ä¤@µ§¸ê®Æ.rar (55.44 KB)


¹Á¸Õ¼¶¼g¨â­ÓÃD¥Ø¡A§V¤Oºô¸ô¬d¸ß¬ã¨s¤¤¡A«e½ú¦³ªÅÁٽйL¥Ø¡A·PÁÂ

Private Sub CommandButton5_Click()
    For i = 2 To 10
        If Sheets(2).Cells(i, 8) <> "" Then
            For j = 2 To 10
               
                If Sheets(1).Cells(j, 8) = "" Then
                    Sheets(1).Cells(j, 2) = Sheets(2).Cells(j, 2)
                    Sheets(1).Cells(j, 3) = Sheets(2).Cells(j, 3)
                    Sheets(1).Cells(j, 4) = Sheets(2).Cells(j, 4)
                    Sheets(1).Cells(j, 5) = Sheets(2).Cells(j, 5)
                    Sheets(1).Cells(j, 6) = Sheets(2).Cells(j, 6)
                    Sheets(1).Cells(j, 7) = Sheets(2).Cells(j, 7)
                    Sheets(1).Cells(j, 8) = Sheets(2).Cells(j, 8)
                End If
            Next
        End If
    Next
End Sub
¸Õ¸Õ¬Ý
§ù¤p¥­

TOP

¥»©«³Ì«á¥Ñ av8d ©ó 2023-3-2 10:59 ½s¿è

¦^´_ 2# dou10801

ÁÂÁ«e½ú¡Aªøªº´X¥G¤@¼Ò¤@¼Ë«o¦³«e«á®t²§¡A§Ú±a¦^¥h¦n¦n¬ã¨s¤@¤U¡C
(­ì¨Ó¬O§Ú§âi¥´¦¨jÀª§¼¤F¡A·PÁÂ)

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-3-2 11:43 ½s¿è

¦^´_ 1# av8d


    ÁÂÁ«e½ú­Ì
«á¾Ç¬ã¨s¾Ç²ß¦¹±¡¹Òªº¸Ñ¨M¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò

°õ¦æ«e:
2023-03-02_112549.JPG
2023-3-2 11:31


°õ¦æµ²ªG:
2023-03-02_112600.JPG
2023-3-2 11:32


Option Explicit
Private Sub CommandButton5_Click()
Dim R&, i&, j%
'¡ô«Å§iÅܼÆ:R¬Oªø¾ã¼ÆÅܼÆ,i¬Oªø¾ã¼ÆÅܼÆ,j¬Oµu¾ã¼ÆÅܼÆ
R = Sheets("¥D³õ").Cells(Rows.Count, "H").End(3).Row
'¡ô¥OR³oªø¾ã¼Æ¬O ¥D³õªíHÄæ³Ì«á¤@­Ó¦³¤º®eªºÀx¦s®æ¦C¸¹
For i = 2 To Sheets("¼ËªO").Cells(Rows.Count, "H").End(3).Row   '³o¥~°j°é¶]Áa¦V(¦C)
'¡ô³]¥~¶¶°j°é!i±q2 ¨ì ¼ËªOªíHÄæ³Ì«á¤@­Ó¦³¤º®eªºÀx¦s®æ¦C¸¹
   If Sheets("¼ËªO").Cells(i, 8) <> "" Then
   '¡ô¦pªG¼ËªOªíªº i°j°é¦CHÄæÀx¦s®æ­È ¤£¬OªÅ¦r¤¸??
      R = R + 1
      '¡ô¦bIf±ø¥ó¦¨¥ß«á,¥²¶·¥OR²Ö¥[1,
      '¦]¬°²Å¦X±ø¥óªº¸ê®Æ¥²¶·©ñ¦b¥D³õªíªº²Ä¤@ªÅ¦C

      For j = 1 To 8    '³o¤º°j°é¶]¾î¦V(Äæ)
      '¡ô³]¤º¶¶°j°é!j±q1 ¨ì8
         Sheets("¥D³õ").Cells(R, j) = Sheets("¼ËªO").Cells(i, j)
         '¡ô¥O¥D³õªí R¦Cj°j°éÄ檺Àx¦s®æ­È¬O ¼ËªOªíªº i°j°é¦Cj°j°éÄæÀx¦s®æ­È
      Next
   End If
Next
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¥»©«³Ì«á¥Ñ av8d ©ó 2023-3-2 13:37 ½s¿è

¦^´_ 4# Andy2483


ÁÂÁ«e½ú¡A±zµ¹ªºµª®×¥¿¬O§Ú­nªº¡A¦Ó¥B¼¶¼gªº§ó²³æ(¤é«á§Ú·|´Â³o¤è¦VÁÚ¶i)¡A¨ü¯q¨}¦h¡A
§Ú­è¤S­×§ï¤F¤@¤U¡Aªþ¤W§Ú¼¶¼g(¦ý¸û¬°Ãlªøªº)¡C

¥u§ì¨ì²Ä¤@µ§¸ê®Æ(¤w§¹¦¨).rar (57.07 KB)

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-3-2 14:43 ½s¿è

¦^´_ 5# av8d


    ÁÂÁ«e½ú¦^´_¤@°_¾Ç²ß
1.«e½ú¦Û¾ÇªºÅÞ¿è»Pµ²ªG¹ï¤F´N«Ü¦n¤F,µu¤£¤@©w¬O³Ì¦nªº,¦]¬°¹ï±¡¹Òªº²q´ú²z¸Ñ³£¦]¤H¦Ó²§
2.¦Û°ÊÂX¥R.Âo­«½Æ.¨¾¿ù..µ¥µ¥³£¬O«á¾Ç·Q¾Ç²ßªº
3.«Øij«e½ú¾i¦¨«Å§iÅܼƪº²ßºD,¦³«Ü¦h¦n³B

³o¬O«á¾Ç¬ã¨s«e½ú¤è®×ªº²z¸Ñ
Option Explicit
Private Sub CommandButton5_Click()
Dim i&, j&, k%
'¡ô«Å§iÅܼÆ:(i,j)¬Oªø¾ã¼Æ,k¬Oµu¾ã¼Æ
For i = 2 To 100
'¡ô³]¶¶°j°éi±q2 ¨ì100
   If Sheets(2).Cells(i, 8) <> "" Then
   '¡ô¦pªGªí2ªºi°j°é¦CHÄæÀx¦s®æ¤£¬OªÅ¦r¤¸??
      j = 2
      '¡ô¥OjÅܼƬO 2
JJ:   If Sheets(1).Cells(j, 8) = "" Then
      '¡ô¦pªGªí1ªºi°j°é¦CHÄæÀx¦s®æ¬OªÅ®æ??
         For k = 2 To 8
         '¡ô³]¶¶°j°ék±q2 ¨ì8
            Sheets(1).Cells(j, k) = Sheets(2).Cells(i, k)
            '¡ô¥Oªí1ªºj°j°é¦Ck°j°éÄæÀx¦s®æ­È¬O ªí2ªºiÅܼƦCk°j°éÄæÀx¦s®æ­È
         Next
         Else
         '¡ô§_«h(ªí1ªºi°j°é¦CHÄæÀx¦s®æ¤£¬OªÅ®æ)
            j = j + 1
            '¡ô´N¥OjÅܼÆ+1
            GoTo JJ
            '¡ô¸õ¨ì JJ¼Ð¥Üªºµ{§Ç¦ì¸mÄ~Äò°õ¦æ
      End If
   End If
Next
End Sub


¥H¤U¬O¥t¤@­ÓÅܼƤƪº½m²ß,½Ð°Ñ¦Ò
Private Sub CommandButton5_Click()
Dim R&, R1&, i&, j%, Arr, Sh1 As Range, Sh2 As Range
Set Sh1 = Sheets("¥D³õ").Cells
Set Sh2 = Sheets("¼ËªO").Cells
R = Sh1(65536, 8).End(3).Row
R1 = Sh2(65536, 8).End(3).Row
For i = 2 To R1
   If Sh2(i, 8) <> "" Then
      R = R + 1
      For j = 1 To 8
         Sh1(R, j) = Sh2(i, j)
      Next
   End If
Next
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 1# av8d


    ³o¬O«á¾Ç½m²ß°}¦Cªº¤è®×,½Ð°Ñ¦Ò

Private Sub CommandButton5_Click()
Dim R&, i&, j%, Arr
Arr = Range([¼ËªO!A1], [¼ËªO!H65536].End(3))
For i = 2 To UBound(Arr)
   If Arr(i, 8) <> "" Then
      R = R + 1
      For j = 1 To UBound(Arr, 2)
         Arr(R, j) = Arr(i, j)
      Next
   End If
Next
[¥D³õ!H65536].End(3).Item(2, -6).Resize(R, UBound(Arr, 2)) = Arr
Set Arr = Nothing
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-3-2 15:52 ½s¿è

¦^´_ 1# av8d


    ³o¬O«á¾Ç¥HHÄæÂo­«½Æ(±Ë«e¨ú«á) ½m²ß¦r¨åªº¤è®×,½Ð«e½ú°Ñ¦Ò

Option Explicit
Private Sub CommandButton5_Click()
Dim R&, i&, j%, Arr, Y, A(1 To 8)
Set Y = CreateObject("Scripting.Dictionary")
Arr = Range([¼ËªO!A1], [¼ËªO!H65536].End(3))
For i = 2 To UBound(Arr)
   If Arr(i, 8) = "" Then GoTo REAR
      For j = 1 To UBound(Arr, 2)
         A(j) = Arr(i, j)
      Next
      Y(Arr(i, 8)) = A
REAR: Next
[¥D³õ!H65536].End(3).Item(2, -6).Resize(Y.Count, UBound(A)) = _
Application.Transpose(Application.Transpose(Y.ITEMS))
Set Arr = Nothing: Set Y = Nothing: Erase A
End Sub


³o¬O«á¾Ç¥HHÄæÂo­«½Æ(¨ú«e²¤«á) ½m²ß¦r¨åªº¤è®×,½Ð«e½ú°Ñ¦Ò
Private Sub CommandButton5_Click()
Dim R&, i&, j%, Arr, Y, A(1 To 8)
Set Y = CreateObject("Scripting.Dictionary")
Arr = Range([¼ËªO!A1], [¼ËªO!H65536].End(3))
For i = 2 To UBound(Arr)
   If Arr(i, 8) = "" Or Y.Exists(Arr(i, 8)) <> Empty Then GoTo REAR
      For j = 1 To UBound(Arr, 2)
         A(j) = Arr(i, j)
      Next
      Y(Arr(i, 8)) = A
REAR: Next
[¥D³õ!H65536].End(3).Item(2, -6).Resize(Y.Count, UBound(A)) = _
Application.Transpose(Application.Transpose(Y.ITEMS))
Set Arr = Nothing: Set Y = Nothing: Erase A
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 1# av8d

ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
¥i¥H½m²ß«Ü¦h¤èªk,¥H¤U¬O¦r¨å¥ýÂoHÄæ­«½Æ­È,Item¬O¦C¸¹
³Ì«á¥HItem¤Þ¾É°}¦C±a¤J¥t¤Gºû°}¦C

Option Explicit
Private Sub CommandButton5_Click()
Dim R&, i&, j%, Arr, Y, Brr, A
Set Y = CreateObject("Scripting.Dictionary")
Arr = Range([¼ËªO!A1], [¼ËªO!H65536].End(3))
For i = 2 To UBound(Arr)
   If Arr(i, 8) <> "" Then Y(Arr(i, 8)) = i
Next
ReDim Brr(1 To Y.Count, 1 To 8)
For Each A In Y.Items
   R = R + 1
   For j = 1 To UBound(Arr, 2)
      Brr(R, j) = Arr(A, j)
   Next
Next
[¥D³õ!H65536].End(3).Item(2, -6).Resize(Y.Count, 8) = Brr
Set Arr = Nothing: Set Brr = Nothing: Set Y = Nothing
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-3-3 09:16 ½s¿è

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾Ç½Æ²ß¬Q¤Ñªº²ßÃD,½Æ²ß¤ß±o¦p¤U,½Ð«ü±Ð

Option Explicit
Private Sub CommandButton5_Click()
Dim R&, R1&, i&, j%, Arr, Sh1 As Range, Sh2 As Range
'¡ô«Å§iÅܼÆ:(R,R1,i)¬Oªø¾ã¼ÆÅܼÆ,j¬Oµu¾ã¼ÆÅܼÆ,(Sh1,Sh2)¬OÀx¦s®æÅܼÆ
Set Sh1 = Sheets("¥D³õ").Cells
'¡ô¥OSh1³oÀx¦s®æÅܼƬO ¥D³õªíªº©Ò¦³Àx¦s®æ
Set Sh2 = Sheets("¼ËªO").Cells
'¡ô¥OSh2³oÀx¦s®æÅܼƬO ¼ËªOªíªº©Ò¦³Àx¦s®æ
R = Sh1(65536, 8).End(3).Row
'¡ô¥OR³oªø¾ã¼ÆÅܼƬO Sh1ÅܼƪºHÄæ³Ì«á¤@­Ó¦³¤º®eªºÀx¦s®æ¦C¸¹
R1 = Sh2(65536, 8).End(3).Row
'¡ô¥OR1³oªø¾ã¼ÆÅܼƬO Sh2ÅܼƪºHÄæ³Ì«á¤@­Ó¦³¤º®eªºÀx¦s®æ¦C¸¹
For i = 2 To R1
'¡ô³]¶¶°j°é!i±q2 ¨ìR1ÅܼÆ
   If Sh2(i, 8) <> "" Then
   '¡ô¦pªGSh2Åܼƪºi°j°é¦C²Ä8Ä椣¬OªÅ®æ(¦pªG¼ËªOªíªºHÄæiÅܼƦCÀx¦s®æ¤£¬OªÅ¥Õ)
      R = R + 1
      '¡ô¥ORÅܼƲ֥[1
      For j = 1 To 8
      '¡ô³]¶¶°j°é!j±q1¨ì 8
         Sh1(R, j) = Sh2(i, j)
         '¡ô¥OSh1ÅܼƪºRÅܼƦC²ÄjÅܼÆÄæÀx¦s®æ­È¬O Sh2ÅܼƪºiÅܼƦC²ÄjÅܼÆÄæÀx¦s®æ­È
      Next
   End If
Next
End Sub
====================================================
Option Explicit
Private Sub CommandButton5_Click()
Dim R&, i&, j%, Arr
'¡ô«Å§iÅܼÆ:(R,i)¬Oªø¾ã¼ÆÅܼÆ,j¬Oµu¾ã¼ÆÅܼÆ,Arr¬O³q¥Î«¬ÅܼÆ
Arr = Range([¼ËªO!A1], [¼ËªO!H65536].End(3))
'¡ô¥OArr³o³q¥Î«¬ÅܼƬO ¼ËªOªí[A1]¨ìHÄæ³Ì«á¤@¦³¤º®eÀx¦s®æ,
'³o¨â­ÓÀx¦s®æÂX®i¥X³Ì¤pªº¤è¥¿½d³ò Àx¦s®æ­È

For i = 2 To UBound(Arr)
'¡ô³]¶¶°j°é!i±q2 ¨ìArr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
   If Arr(i, 8) <> "" Then
   '¡ô¦pªGi°j°é¦C²Ä8ÄæArr°}¦C­È ¤£¬OªÅ¦r¤¸?
      R = R + 1
      '¡ô¥OR³oªø¾ã¼ÆÅܼƲ֥[1
      For j = 1 To UBound(Arr, 2)
      '¡ô³]¶¶°j°é!j±q1 ¨ìArr°}¦C¾î¦V³Ì¤j¯Á¤ÞÄ渹
         Arr(R, j) = Arr(i, j)
         '¡ô¥ORÅܼƦC²ÄjÄ檺Arr°}¦C­È¬O i°j°é¦C²ÄjÄ檺Arr°}¦C­È
      Next
   End If
Next
[¥D³õ!H65536].End(3).Item(2, -6).Resize(R, UBound(Arr, 2)) = Arr
'¡ô¥O¥D³õªíHÄæ³Ì«á¤@¦³¤º®eÀx¦s®æºâ°_,©¹¤U1¦C,©¹¥ª7Ä檺¨º¤@®æ¶}©lÂX®i,
'ÂX®i¦V¤UR¦C,¦V¥kÂX®iArr°}¦C¾î¦V³Ì¤j¯Á¤ÞÄ渹¼ÆÄæ,
'³oÂX®i½d³òÀx¦s®æ­È¥HArr°}¦C­È±a¤J

Set Arr = Nothing
'¡ôÄÀ©ñÅܼÆ
End Sub
====================================================
Option Explicit
Private Sub CommandButton5_Click()
Dim R&, i&, j%, Arr, Y, A(1 To 8)
'¡ô«Å§iÅܼÆ:(R,i)¬Oªø¾ã¼ÆÅܼÆ,j¬Oµu¾ã¼ÆÅܼÆ,(Arr,Y)¬O³q¥Î«¬ÅܼÆ
'A¬O¤@ºû°}¦C(±q1¨ì8¯Á¤Þ¸¹)
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OY³o³q¥Î«¬ÅܼƬO ¦r¨å
Arr = Range([¼ËªO!A1], [¼ËªO!H65536].End(3))
'¡ô¥OArr³o³q¥Î«¬ÅܼƬO¤Gºû°}¦C,¥H¼ËªOªí[A1]¨ìHÄæ³Ì«á¤@¦³¤º®eÀx¦s®æ,
'³o½d³òÀx¦s®æ­È­Ë¤JArr°}¦C¸Ì

For i = 2 To UBound(Arr)
'¡ô³]¶¶°j°é!i±q2 ¨ìArr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
   If Arr(i, 8) = "" Then GoTo REAR
   '¡ô¦pªGi°j°é¦C²Ä8ÄæArr°}¦C­È¬O ªÅ¦r¤¸!
   '´N¸õ¨ì REAR¼Ð¥Üªºµ{§Ç¦ì¸mÄ~Äò°õ¦æ

      For j = 1 To UBound(Arr, 2)
      '¡ô³]¶¶°j°é!j±q1 ¨ìArr°}¦C¾î¦V³Ì¤j¯Á¤ÞÄ渹¼Æ
         A(j) = Arr(i, j)
         '¡ô¥Oj¯Á¤Þ¸¹A°}¦C­È¬O i°j°é¦Cj°j°éÄæArr°}¦C­È
      Next
      Y(Arr(i, 8)) = A
REAR: Next
[¥D³õ!H65536].End(3).Item(2, -6).Resize(Y.Count, UBound(A)) = _
Application.Transpose(Application.Transpose(Y.ITEMS))
'¡ô¥O¥D³õªíHÄæ³Ì«á¤@¦³¤º®eÀx¦s®æºâ°_,©¹¤U1¦C,©¹¥ª7Ä檺¨º¤@®æ¶}©lÂX®i,
'ÂX®i¦V¤UY¦r¨å¸ÌKey¼Æ¶q ¦C,¦V¥kÂX®iA°}¦C³Ì¤j¯Á¤Þ¸¹¼ÆÄæ,
'³oÂX®i½d³òÀx¦s®æ­È¥HY¦r¨åªºItemÂà¸m¨â¦¸«á±a¤J

Set Arr = Nothing: Set Y = Nothing: Erase A
'¡ô¥OÄÀ©ñÅܼÆ
End Sub
====================================================
Option Explicit
Private Sub CommandButton5_Click()
Dim R&, i&, j%, Arr, Y, A(1 To 8)
'¡ô«Å§iÅܼÆ:(R,i)¬Oªø¾ã¼ÆÅܼÆ,j¬Oµu¾ã¼ÆÅܼÆ,(Arr,Y)¬O³q¥Î«¬ÅܼÆ
'A¬O¤@ºû°}¦C(±q1¨ì8¯Á¤Þ¸¹)
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OY³o³q¥Î«¬ÅܼƬO ¦r¨å
Arr = Range([¼ËªO!A1], [¼ËªO!H65536].End(3))
'¡ô¥OArr³o³q¥Î«¬ÅܼƬO¤Gºû°}¦C,¥H¼ËªOªí[A1]¨ìHÄæ³Ì«á¤@¦³¤º®eÀx¦s®æ,
'³o½d³òÀx¦s®æ­È­Ë¤JArr°}¦C¸Ì

For i = 2 To UBound(Arr)
'¡ô³]¶¶°j°é!i±q2 ¨ìArr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
   If Arr(i, 8) = "" Or Y.Exists(Arr(i, 8)) <> Empty Then GoTo REAR
   '¡ô¦pªGi°j°é¦C²Ä8ÄæArr°}¦C­È¬O ªÅ¦r¤¸!
   '©Î¥Hi°j°é¦C²Ä8ÄæArr°}¦C­È¬°key¬dY¦r¨å,¬d±o¨ì³okey¤w¸g¦s¦b!
   '´N¸õ¨ì REAR¼Ð¥Üªºµ{§Ç¦ì¸mÄ~Äò°õ¦æ

      For j = 1 To UBound(Arr, 2)
      '¡ô³]¶¶°j°é!j±q1 ¨ìArr°}¦C¾î¦V³Ì¤j¯Á¤ÞÄ渹¼Æ
         A(j) = Arr(i, j)
         '¡ô¥Oj¯Á¤Þ¸¹A°}¦C­È¬O i°j°é¦Cj°j°éÄæArr°}¦C­È
      Next
      Y(Arr(i, 8)) = A
REAR: Next
[¥D³õ!H65536].End(3).Item(2, -6).Resize(Y.Count, UBound(A)) = _
Application.Transpose(Application.Transpose(Y.ITEMS))
'¡ô¥O¥D³õªíHÄæ³Ì«á¤@¦³¤º®eÀx¦s®æºâ°_,©¹¤U1¦C,©¹¥ª7Ä檺¨º¤@®æ¶}©lÂX®i,
'ÂX®i¦V¤UY¦r¨å¸ÌKey¼Æ¶q ¦C,¦V¥kÂX®iA°}¦C³Ì¤j¯Á¤Þ¸¹¼ÆÄæ,
'³oÂX®i½d³òÀx¦s®æ­È¥HY¦r¨åªºItemÂà¸m¨â¦¸«á±a¤J

Set Arr = Nothing: Set Y = Nothing: Erase A
'¡ô¥OÄÀ©ñÅܼÆ
End Sub
====================================================
Option Explicit
Private Sub CommandButton5_Click()
Dim R&, i&, j%, Arr, Brr, Y, A
'¡ô«Å§iÅܼÆ:(R,i)¬Oªø¾ã¼ÆÅܼÆ,j¬Oµu¾ã¼ÆÅܼÆ,
'(Arr,Brr,Y,A)¬O³q¥Î«¬ÅܼÆ

Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OY³o³q¥Î«¬ÅܼƬO ¦r¨å
Arr = Range([¼ËªO!A1], [¼ËªO!H65536].End(3))
'¡ô¥OArr³o³q¥Î«¬ÅܼƬO¤Gºû°}¦C,¥H¼ËªOªí[A1]¨ìHÄæ³Ì«á¤@¦³¤º®eÀx¦s®æ,
'³o½d³òÀx¦s®æ­È­Ë¤JArr°}¦C¸Ì

For i = 2 To UBound(Arr)
'¡ô³]¶¶°j°é!i±q2 ¨ìArr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
   If Arr(i, 8) <> "" Then Y(Arr(i, 8)) = i
   '¡ô¦pªGi°j°é¦C²Ä8ÄæArr°}¦C­È¤£¬OªÅ¦r¤¸!´N¥H³o°}¦C­È·íkey,
   'Item¬OiÅܼÆ,©ñ¤JY¦r¨å¸Ì

Next
ReDim Brr(1 To Y.Count, 1 To 8)
'¡ô«Å§iBrrÅܼƬO¤Gºû°}¦C!°}¦C¤j¤p½d³ò:Áa¦V1¯Á¤Þ¸¹¦C¨ì(Y¦r¨åkey¼Æ)¯Á¤Þ¸¹¦C,
'¾î¦V±q1¯Á¤Þ¸¹Äæ¨ì8¯Á¤Þ¸¹Äæ

For Each A In Y.Items
'¡ô³]¶¶°j°é!¥OA¬OY¦r¨å¸ÌItemªº¤@­û
   R = R + 1
   '¡ô¥OR³oªø¾ã¼ÆÅܼƲ֥[1
   For j = 1 To UBound(Arr, 2)
   '¡ô³]¶¶°j°é!j±q1 ¨ìArr°}¦C¾î¦V³Ì¤j¯Á¤ÞÄ渹
      Brr(R, j) = Arr(A, j)
      '¡ô¥ORÅܼƦCjÅܼÆÄæBrr°}¦C­È¬O AÅܼƦCjÄæArr°}¦C­È
   Next
Next
[¥D³õ!H65536].End(3).Item(2, -6).Resize(Y.Count, 8) = Brr
'¡ô¥O¥D³õªíHÄæ³Ì«á¤@¦³¤º®eÀx¦s®æºâ°_,©¹¤U1¦C,©¹¥ª7Ä檺¨º¤@®æ¶}©lÂX®i,
'ÂX®i¦V¤UY¦r¨å¸ÌKey¼Æ¶q ¦C,¦V¥kÂX®i8Äæ,
'³oÂX®i½d³òÀx¦s®æ­È¥HBrr°}¦C­È±a¤J

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

TOP

        ÀR«ä¦Û¦b : ¦a¤WºØ¤Fµæ¡A´N¤£©öªø¯ó¡F¤ß¤¤¦³µ½¡A´N¤£©ö¥Í´c¡C
ªð¦^¦Cªí ¤W¤@¥DÃD