|
好久没来了,今天上来看到有人提到这个问题,重新写了一个汇总的代码,一个按钮搞定
- Sub test()
- Dim arr, brr(), d1 As Object
- Dim x&, y&, i&, str1$
- Dim she1 As Worksheet
- Set d1 = CreateObject("Scripting.Dictionary")
- Set d2 = CreateObject("Scripting.Dictionary")
- For Each she1 In Worksheets
- If she1.Name <> "汇总" Then
- arr = she1.Range("A4:Y" & she1.Range("A65536").End(xlUp).Row)
- For x = 1 To UBound(arr) - 1
- str1 = arr(x, 2) & "|" & arr(x, 3) & "|" & arr(x, 4)
- If Not d1.exists(str1) Then
- i = i + 1
- d1(str1) = i
- ReDim Preserve brr(1 To 25, 1 To i)
- For y = 2 To 5
- brr(y, i) = arr(x, y)
- Next y
- brr(1, i) = i
- End If
- For y = 6 To 25
- brr(y, d1(str1)) = brr(y, d1(str1)) + arr(x, y)
- Next y
- Next x
- End If
- Next she1
- With Sheets("汇总")
- .Range("A4:Y65536") = ""
- .Range("A4").Resize(UBound(brr, 2), UBound(brr)) = Application.Transpose(brr)
- End With
- d1.RemoveAll
- Erase arr, brr
- End Sub
复制代码
|
|