VBA实现相同行合并

 1 Sub test()
 2   Dim r%, i%
 3   Dim arr, brr
 4   Dim d As Object
 5   Set d = CreateObject("scripting.dictionary")
 6   With Worksheets("sheet1")
 7     r = .Range("a1").End(xlDown).Row
 8     arr = .Range("a2:e" & r)
 9     For i = 1 To UBound(arr)
10       If Not d.exists(arr(i, 2) & arr(i, 3) & arr(i, 4)) Then
11         ReDim brr(1 To UBound(arr, 2))
12         For j = 1 To UBound(arr, 2)
13           brr(j) = arr(i, j)
14         Next
15       Else
16         brr = d(arr(i, 2) & arr(i, 3) & arr(i, 4))
17         brr(1) = brr(1) & " " & arr(i, 1)
18         brr(5) = brr(5) + arr(i, 5)
19 
20       End If
21       d(arr(i, 2) & arr(i, 3) & arr(i, 4)) = brr
22     Next
23     .Range("h2").Resize(d.Count, UBound(brr)) = Application.Transpose(Application.Transpose(d.items))
24   End With
25 End Sub