Hsieh

¦^´_ 1# marklos

1. Sub ex()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. With ¤u§@ªí1
   
4. For Each a In .Range(.[A1], .[A1].End(xlDown))
   
5. If a.Offset(, 6) <> 0 Then
   
6.   If IsEmpty(d(a.Value)) Then
   
7.      d(a.Value) = Application.Transpose(Application.Transpose(a.Resize(, 9).Value))
   
8.      Else
   
9.      ar = d(a.Value)
   
10.      ar(4) = ar(4) & "/" & a.Offset(, 3).Value
    
11.      ar(6) = ar(6) + a.Offset(, 5).Value
    
12.      ar(7) = ar(7) & "," & a.Offset(, 6).Value
    
13.      d(a.Value) = ar
    
14.    End If
    
15. End If
    
16. Next
    
17. End With
    
18. With ¤u§@ªí2
    
19. .Cells = ""
    
20. .[A1].Resize(d.Count, 9) = Application.Transpose(Application.Transpose(d.items))
    
21. End With
    
22. End Sub

½Æ»s¥N½X