GBKEE

¦^´_ 3# rouber590324
¸Õ¸Õ¬Ý

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim D As Object, Rng As Range, AR()
   
4.     Set D = CreateObject("SCRIPTING.DICTIONARY") '¦r¨åª«¥ó
   
5.     Set Rng = Sheets("Sheet1").Range("a1")  '
   
6.     Do While Rng <> ""
   
7.         If D.EXISTS(Rng & Rng(1, 2)) Then 'key(ÃöÁä¦r)­È¦s¦b
   
8.             AR = D(Rng & Rng(1, 2))       '¨ú±o¤º®e
   
9.             AR(1, 4) = Rng(1, 4)
   
10.             D(Rng & Rng(1, 2)) = AR       'key(ÃöÁä¦r)­È ¤º®e­«·s¸m¤J
    
11.         Else
    
12.             D(Rng & Rng(1, 2)) = Rng.Resize(, 4)
    
13.         End If
    
14.         Set Rng = Rng.Offset(1)  '¤U²¾¤@­ÓÀx¦s®æ
    
15.     Loop
    
16.     With Sheets(2)
    
17.         .Cells.Clear
    
18.         .[A1].Resize(D.Count, 4) = Application.Transpose(Application.Transpose(D.ITEMS))
    
19.     End With
    
20. End Sub

½Æ»s¥N½X