【代码】逐级汇总（数组、字典）：财务同学看过来，科目余额表逐级汇总
文摘
教育
2024-10-07 21:43
江苏
1、在工作表“科目余额表”里，命令按钮点击事件，调用汇总过程：Private Sub CmdSum_Click() Call mySumByLevelEnd Sub
2、在myModule里，mySumByLevel逐级汇总过程：第一部分：把数据装入数组，标记科目是否末级，存入字典Sub mySumByLevel() '//定义变量 Dim i As Integer, j As Integer, total As Double Dim ws As Worksheet, lRow As Integer, lCol As Integer, rng As Range Dim dic As Object, dkey, dkey1, dkey2 Dim arr() '//对象赋值 Set ws = ThisWorkbook.Sheets("科目余额表") Set dic = CreateObject("Scripting.Dictionary") '//把数据装入数组 With ws lRow = .UsedRange.Rows.Count lCol = 3 Set rng = .Cells(1, 1).Resize(lRow, 3) arr = rng.Value End With '//把数据装入字典，item统一赋值TRUE，意为“末级科目” For i = 2 To lRow dkey = arr(i, 1) If dkey <> "" Then dic(dkey) = True End If Next '//把非末级科目，在字典中的item改为False '//通过两层循环比对，针对当前科目代码，如果找到一个包含当前科目代码的科目代码， '//则可以断定，当前科目代码为非末级科目代码 For Each dkey1 In dic.keys For Each dkey2 In dic.keys If dkey1 <> dkey2 And InStr(dkey2, dkey1) > 0 Then dic(dkey1) = False Exit For End If Next Next '//输入到工作表临时查看结果 ws.Cells(2, 5).Resize(dic.Count) = Application.Transpose(dic.keys) ws.Cells(2, 6).Resize(dic.Count) = Application.Transpose(dic.items)
第二部分：循环数组arr，汇总非末级科目，结果回写到工作表 '//循环数组，对非末级科目进行汇总，规则是开头是此非末级科目的所有末级科目汇总 For i = 2 To lRow dkey1 = arr(i, 1) If Not dic(dkey1) Then total = 0 For j = 2 To lRow dkey2 = arr(j, 1) If dkey1 <> dkey2 And dic(dkey2) And InStr(dkey2, dkey1) = 1 Then total = total + arr(j, 3) End If Next arr(i, 3) = total End If Next rng.Columns(1).NumberFormat = "@" rng.Value = arrEnd Sub
![]()
| 安利小店
安利的牙膏非常不错，用了以后就不想再用其他的了；洗洁精、洗衣液也是日常必备，用过都说好！ |
![]()
| 合谷医疗
合谷医疗专攻各种疑难杂症，尤其擅长抑郁症、焦虑失眠、儿童神经发育异常、多动症、自闭孤独症、腰颈椎疾病治疗，可谓神乎其技！体验过的直呼早点来就好了！ |
喜欢就点个赞、点在看、留言评论、分享一下呗！感谢支持！
