VBA把数量不同的多表进行汇总

上一篇用了函数：

VBA汇总文件夹中的多文件的工作表中不同单元格区域到总表

下面用VBA代码完成

【问题】有很多个表，各表的数据量也不同，只有一个相同的地方是“标题行数一样”

现在我们想把他们的数据进行汇总，并且把单位相同的后面的数据要相加

例如：表1中的“越女剑”要和表6中的“越女剑”人数与金额相加

表3、表5、表6中都有单位“鸳鸯刀”，要把他们的人数与金额相加

【解决问题】各表的数据不同，用代码取最后一行，观察表中有“单位”列，没有数据不要

两个字典相结合，再用数组进行统计

汇总表暂行为空表

【代码】

Sub 数量不同的多表的汇总()

'要求：表头相同，最后一行的A列是“合计”两字为关键字的为结尾

Dim sht As Worksheet

Dim dic1 As Object, dic2 As Object

Set dic1 = CreateObject("Scripting.Dictionary")

Set dic2 = CreateObject("Scripting.Dictionary")

s= "*"

title_row = 3

Lcol = 4

For Each sht In Sheets

With sht

If .Name <> "汇总" Then

Lrow =.Cells.Find("*", Cells(1, 1), , , 1, 2).Row

'Lcol ='.Cells.Find("*", Cells(1, 1), , , 2, 2).Column

' Debug.Print sht.Name, Lrow,dic1.Count

For i = title_row + 1 To Lrow

If .Cells(i, 2) <>"" Then

' Debug.Print .Cells(i,3), .Cells(i, 4)

dic1(dic1.Count + 1) =Array(.Cells(i, 2), .Cells(i, 3), .Cells(i, 4))

End If

Next i

End If

End With

Next

' MsgBox dic1.Count

temparr = Application.Transpose(Application.Transpose(dic1.items))

For j = 1 To UBound(temparr)

If dic2.Exists(temparr(j, 1)) Then

t_brr = dic2(temparr(j, 1))

t_brr(1) = t_brr(1) + temparr(j, 2)

t_brr(2) = t_brr(2) + temparr(j, 3)

dic2(temparr(j, 1)) = t_brr

Else

dic2(temparr(j, 1)) = Array(temparr(j, 1), temparr(j, 2), temparr(j, 3))

End If

Next j

With Sheets("汇总")

crr = Application.Transpose(Application.Transpose(dic2.items))

.Range("b4").Resize(UBound(crr, 1), UBound(crr, 2)) = crr

For k = 1 To UBound(crr, 1)

.Cells(title_row + k, 1) = k

Next k

End With

End Sub

【效果】

====今天学习到此====