- Sub Macro1()
- On Error Resume Next
- Dim arr, brr, d, i&, j%, k%, s&
- Set d = CreateObject("scripting.dictionary")
- arr = Sheets("数据源").Range("a1").CurrentRegion
- ReDim brr(1 To UBound(arr), 1 To 10)
- For i = 3 To UBound(arr)
- p = ""
- For j = 4 To 10
- p = p & "," & arr(i, j)
- Next
- If Not d.exists(p) Then
- s = s + 1
- d(p) = s
- For k = 4 To 10
- brr(s, k - 3) = arr(i, k)
- Next
- brr(s, 8) = arr(i, 12)
- brr(s, 9) = arr(i, 13)
- brr(s, 10) = arr(i, 14)
- Else
- n = d(p)
- brr(n, 8) = brr(n, 8) + arr(i, 12)
- brr(n, 10) = brr(n, 10) + arr(i, 14)
- End If
- Next
- Sheets("汇总").Range("a3").Resize(s, UBound(brr, 2)) = brr
- End Sub
复制代码 |