利用excel vba进行分级汇总，只需要简单的语言，不需要sql

liujie0019

我们在日常工作中，经常会遇到分级汇总的情况，如下：

科目编码	科目设置	科目名称	金额
4	1级	管理费用	=4.1+4.2
4.1	2级	办公费用	=sum(4.1.1,4.1.3)
4.1.1	3级	办公用品	100
4.1.2	3级	行政服务费	200
4.1.3	3级	办公环境费	300
4.2	2级	业务费用	=sum(4.2.1,4.2.4)
4.2.1	3级	差旅费	200
4.2.2	3级	业务招待费	300
4.2.3	3级	交通费	400
4.2.4	3级	通讯费	50

我看到网上很多分级汇总的方法都是利用sql的，代码很多很复杂，其实只需要加一个参数和二次循环就可以搞点，代码如下:

具体的案例，请看附件的excel，谢谢~

Sub 利用计数基数分级汇总()
    Dim i As Long, n As Long, j As Long   '声明变量
    Dim r1 As Long, r2 As Long, r3 As Long
   
    Application.ScreenUpdating = False
   
    r1 = Range("a65535").End(3).Row    '读取数据区域最后一行的行数
   
    For i = 2 To r1   '第一次循环：把三级汇总到二级
        r2 = Len(Cells(i, 1))   '利用len函数读取第一列科目编码单元格的字符数量，一级科目：4就是1个字符，二级科目：4.1就是3个字符
        If r2 >= 5 Then    '首先，计算3级科目的汇总，三级科目为5个字符串
            n = n + 1            'n为计数参数，计算三级科目有多少个，当有一个三级科目时候n为1，第二个三级科目n为2
            j = i - n       'j为计数参数，用来核算3级科目对应汇总到的二级科目所在的行数
            Cells(j, "e") = Cells(j, "e") + Cells(i, "e")    '汇总三级的金额
        Else
            n = 0       '这个非常重要，当循环从三级科目到耳机科目时候，n要归零，这样才能进行下一个二级科目的汇总
        End If
    Next
   
    n = o
    j = 0
   
    For i = 2 To r1   '第二次循环：把二级汇总到一级
        r3 = Len(Cells(i, 1))
        If r3 >= 3 Then
            n = n + 1
            j = i - n
            If r3 = 3 Then
                Cells(j, "e") = Cells(j, "e") + Cells(i, "e")
            End If
        Else
            n = 0
        End If
    Next
   
    Application.ScreenUpdating = True
   
End Sub

原理如下：