GBKEE

¦^´_ 1# sandra_wang

1. Sub Ex()
   
2.     Dim D As Object, R, S$, Rng As Range
   
3.     Set D = CreateObject("Scripting.Dictionary")
   
4.     With ActiveSheet
   
5.          .[HR9].Resize(, 7).Copy .[HZ9]
   
6.          .[HZ9].CurrentRegion.Offset(1).Clear
   
7.         For Each R In .Range(.[HR10], .[HR10].End(xlDown))
   
8.             S = Join(Application.Transpose(Application.Transpose(R.Resize(, 6))), ",")
   
9.             D(S) = D(S) + R(1, 7)
   
10.         Next
    
11.         Set Rng = .[HZ9].Offset(1)
    
12.         For Each R In D.KEYS
    
13.             Rng.Resize(, 6) = Split(R, ",")
    
14.             Rng.Offset(, 6) = D(R)
    
15.             Set Rng = Rng.Offset(1)
    
16.         Next
    
17.     End With
    
18. End Sub

½Æ»s¥N½X