Hsieh

¦^´_ 2# melvinhsu

1. Sub ex()
   
2. Dim A As Range
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. With Sheets(1)
   
5. For Each A In .Range(.[A2], .[A2].End(xlDown))
   
6.   If IsEmpty(d(A.Value)) Then
   
7.      Set d(A.Value) = A.Resize(, 3)
   
8.      Else
   
9.      Set d(A.Value) = Union(d(A.Value), A.Resize(, 3))
   
10.   End If
    
11. Next
    
12. End With
    
13. With Sheets(2)
    
14. .UsedRange.Offset(1).Clear '²MªÅ­ì¦³¸ê®Æ
    
15. r = 2
    
16. For Each ky In d.keys
    
17. r = IIf(i = 0, 2, 1)
    
18. d(ky).Copy .Cells(r + i * 20, 1) '½Æ»s¨ì¤u§@ªí2
    
19. k = Int(d(ky).Count / 3 / 20) '­pºâ©Ò¥e­¶¼Æ
    
20. i = i + k + 1
    
21. Next
    
22. End With
    
23. End Sub

½Æ»s¥N½X