|
- Sub Sheet2_按钮1_Click()
- Dim d As Object
- Set d = CreateObject("scripting.dictionary")
- arr = Range("a1").CurrentRegion
- For i = 1 To UBound(arr)
- If Not d.exists(arr(i, 1)) Then
- Set d(arr(i, 1)) = CreateObject("scripting.dictionary")
- End If
- If Not d(arr(i, 1)).exists(arr(i, 2)) Then
- ReDim brr(1 To 4)
- brr(1) = arr(i, 1): brr(2) = arr(i, 2)
- Else
- brr = d(arr(i, 1))(arr(i, 2))
- End If
- brr(3) = brr(3) + arr(i, 3)
- brr(4) = brr(4) & " " & arr(i, 4)
- d(arr(i, 1))(arr(i, 2)) = brr
- Next i
- '结果放在F列开始
- m = 1
- For Each aa In d.keys
- For Each bb In d(aa).keys
- brr = d(aa)(bb)
- Cells(m, 6).Resize(1, UBound(brr)) = brr
- m = m + 1
- Next
- Next
- End Sub
复制代码 |
|