|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Sub zz()
Dim d, ar, br(1 To 1000, 1 To 25), sh As Worksheet
Set d = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
For Each sh In Sheets
If sh.Name <> "合计" Then
ar = sh.[a5].CurrentRegion
For i = 5 To UBound(ar) - 1
s = ar(i, 2)
If d(s) = "" Then
m = m + 1: d(s) = m: br(m, 1) = m
For j = 2 To UBound(ar, 2)
br(m, j) = ar(i, j)
Next
Else
For j = 3 To UBound(ar, 2)
br(d(s), j) = br(d(s), j) + ar(i, j)
Next
End If
Next
End If
Next
Sheet5.[a5].Resize(m, UBound(br, 2)) = br
Application.ScreenUpdating = True
End Sub
|
|