《美妞》
要求
1、合计当中每个费用科目金额等于后面4个部门对应的费用科目金额合计
2、存在困难是每个部门的费用科目是不是固定的
比如人力部交通费用是在第5行,但是拓展部的交通费用科目是在第2行
3、有没有便捷的方式直接取到各个表当中对应费用科目的金额合计
思路
字典定位累加
代码如下:
Sub mySum3()
Dim myDic As Object
Dim sumArr(1 To 300, 1 To 15), Brr()
Dim bRow As Integer, bCol As Integer, aRow As Integer
Dim Sht As Worksheet, yCol As Integer
Set myDic = CreateObject('Scripting.dictionary')
For Each Sht In Worksheets
If Sht.Name <> '合计' Then
Brr = Sht.UsedRange.Value
For bCol = 2 To UBound(Brr, 2) - 1 '首先处理月标题
yCol = Val(Brr(1, bCol)) + 1
If yCol < 2="" or="" ycol=""> 13 Then '如果标题不是1-12月则将数据汇总列设置到最后一列
Brr(1, bCol) = 15
Else
Brr(1, bCol) = yCol
End If
Next
For bRow = 2 To UBound(Brr, 1) '开始汇总数据
If myDic.exists(Brr(bRow, 1)) = False Then
aRow = myDic.Count + 1
myDic.Add Brr(bRow, 1), aRow
sumArr(aRow, 1) = Brr(bRow, 1)
End If
aRow = myDic.Item(Brr(bRow, 1))
For bCol = 2 To UBound(Brr, 2) - 1
yCol = Brr(1, bCol)
sumArr(aRow, yCol) = Brr(bRow, bCol) + sumArr(aRow, yCol)
sumArr(aRow, 14) = sumArr(aRow, 14) + Brr(bRow, bCol)
Next
Next
End If
Next
Range('A2').Resize(UBound(sumArr)).EntireRow.ClearContents
Range('a2').Resize(myDic.Count, UBound(sumArr, 2)).Value = sumArr
End Sub
***华丽分割线***
合伙人
祝福大家
阖家欢乐
红包多多
联系客服