多表汇总再合并

  • 格式: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