[已解决]汇总

雄鹰2013 · 发表于 2015-2-4 13:08

如何对指定的工作表进行汇总

最佳答案

月排行榜 / 总排行榜

dsmch

2015-2-4 13:28

Sub Macro1()
Dim arr, d, w, j%, i&, zf$
Set d = CreateObject("scripting.dictionary")
w = Array("A", "C", "D", "H", "K")
For i = 0 To UBound(w)
d(w(i)) = ""
Next
For j = 1 To Sheets.Count
zf = Sheets(j).Name
If zf <> "汇总" And Not d.exists(zf) Then
arr = Sheets(j).Range("a1").CurrentRegion
For i = 2 To UBound(arr)
d(arr(i, 1)) = d(arr(i, 1)) + arr(i, 2)
Next
End If
Next
Sheets("汇总").Activate
ActiveSheet.UsedRange.ClearContents
[a1:b1] = Array("姓名", "数量")
Range("a2").Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
Range("a2").Resize(UBound(w) + 1, 2).Delete
End Sub

复制代码

跳转到最佳答案楼层

dsmch · 发表于 2015-2-4 13:28

Sub Macro1()
Dim arr, d, w, j%, i&, zf$
Set d = CreateObject("scripting.dictionary")
w = Array("A", "C", "D", "H", "K")
For i = 0 To UBound(w)
d(w(i)) = ""
Next
For j = 1 To Sheets.Count
zf = Sheets(j).Name
If zf <> "汇总" And Not d.exists(zf) Then
arr = Sheets(j).Range("a1").CurrentRegion
For i = 2 To UBound(arr)
d(arr(i, 1)) = d(arr(i, 1)) + arr(i, 2)
Next
End If
Next
Sheets("汇总").Activate
ActiveSheet.UsedRange.ClearContents
[a1:b1] = Array("姓名", "数量")
Range("a2").Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
Range("a2").Resize(UBound(w) + 1, 2).Delete
End Sub

复制代码

爱疯 · 发表于 2015-2-4 13:48

Sub test()
Dim Path$, Aera$, Arr(), i%

'1）数据源的数组
Path = "'" & ThisWorkbook.Path & "\[" & ThisWorkbook.Name & "]"
Aera = "'!R1C1:R65536C2"
ReDim Arr(2 To Sheets.Count)
For i = LBound(Arr) To UBound(Arr)
Arr(i) = Path & Sheets(i).Name & Aera
Next i

'2）合并计算
Sheets(1).Range("a1").Consolidate Sources:=Arr, Function:=xlSum, TopRow:=True, LeftColumn:=True
End Sub

汇总2015.2.4b.rar (12.29 KB, 下载次数: 29)

		自动登录	找回密码
密码			注册

[已解决]汇总

评分