1、将多个条件合并,用 & 链接在一起,作为一个key放进字典
多条件变单条件
2、然后套路就是 :字典标记行号,单条件多列求和。
代码:
Sub 多表求和()
Dim arr, brr(1 To 10000, 1 To 6), sht As Worksheet, d As Object
Set d = CreateObject('scripting.dictionary')
'遍历所有工作表
For Each sht In Worksheets
'如果工作表不是“汇总”工作表
If sht.Name <> '汇总' Then
'将要求和的数据放进数组arr
arr = sht.[a1].CurrentRegion
'遍历数组元素
For i = 2 To UBound(arr)
'将条件1、2、3合并组成唯一的key放进字典
okey = arr(i, 1) & arr(i, 2) & arr(i, 3)
'每个okey的第一条数据,放在新的数组brr中
'并标记okey在数组brr中的行
If Not d.exists(okey) Then
k = k 1 '计数
d(okey) = k '字典标记行
For j = 1 To 6 '写入每个okey第一条数据
brr(k, j) = arr(i, j)
Next j
Else
'okey第2条数据起,开始进行累加计算
' r 返回okey在数组brr中的行号
r = d(okey)
brr(r, 4) = brr(r, 4) arr(i, 4) '求和1累加
brr(r, 5) = brr(r, 5) arr(i, 5) '求和2累加
brr(r, 6) = brr(r, 6) arr(i, 6) '求和3累加
End If
Next i
End If
Next
'输出求和数据
觉得有用点个赞吧