多表汇总再合并
- 格式:docx
- 大小:15.65 KB
- 文档页数:2
多表汇总再合并
1、说明:每月的人员都有变动,且有重名的出现,
2、要求:效果是名字别出现遗漏.统计出每月的数据。
3、说明:此表我只选择了三张表,其实有12张表。
4、要求:能不能实现有几张表就统计几张表的?
例如,我只有6、7、8三个月,就统计出这三个月的,如果有1、2、3、4、5这几个月的,就统计这五个月的。
此表为汇总的最终结果
VBA代码如下:
Sub 多表汇总合并()
Dim Sht As Worksheet, Arr, Brr
Dim Dic As Object, x%, i&, k&, y&
Set Dic = CreateObject("Scripting.Dictionary")
ReDim Brr(1 To Rows.Count, 1 To 14)
For Each Sht In Sheets
If <> Then
Arr = edRange
x = Val(Arr(1, 1)) + 2
For i = 4 To UBound(Arr)
If Arr(i, 1) <> "" And Arr(i, 2) <> "" Then
If Not Dic.Exists((Arr(i, 1) & Arr(i, 2))) Then
k = k + 1
Dic.Add Arr(i, 1) & Arr(i, 2), k
Brr(k, 1) = Arr(i, 1)
Brr(k, 2) = Arr(i, 2) Brr(k, x) = Arr(i, 3)
Else
y = Dic(Arr(i, 1) & Arr(i, 2))
Brr(y, x) = Brr(y, x) + Arr(i, 3)
End If
End If
Next
End If
Next
edRange.Offset(1).ClearContents
Sheet5.Range("A2").Resize(k, 14) = Brr
End Sub