当前位置：首页>Excel>EXCEL VBA一键实现估预算自下而上逐级汇总,告别手动操作!

EXCEL VBA一键实现估预算自下而上逐级汇总,告别手动操作!

估预算一般是把总预算按照一定的WBS（工作分解结构）进行逐层分解，手动将估算金额写入单元格，然后再逐层按级向上汇总，形成每个层级的分项预算和总预算，模版如下：A列为层级,B列为估算代码,C列为估算金额。C列中的空白单元格需要写入汇总公式。

目前普遍的做法就是在每个层级分项上进行手动输入subtotal,通过肉眼确定每个层级的汇总范围，或者更笨的方案通过一个个逐一相加的方法得到汇总项。

这些方法在数据量小时，还可以考虑，如果面对成百上千行的数据，不仅浪费时间，而且在调整数据或修改时，容易引起公式出错！

下面就安利一个VBA宏命令，可以一键美化结构，自动形成汇总项，代码如下：

为了让代码看起了更简短，我把注释全部删掉，注释可以参数上面图片

Sub 分级操作()

ROWNUM = [A65536].End(xlUp).Row

Level = Application.WorksheetFunction.Max(Range(Cells(2, 1), Cells(ROWNUM, 1)))

ActiveSheet.Outline.SummaryRow = xlAbove

For I = 2 To ROWNUM

Rows(I).OutlineLevel = Cells(I, 1)

Cells(I, 2).IndentLevel = Cells(I, 1)

For I = 1 To ROWNUM

If Cells(I, 1) < Cells(I + 1, 1) Then

Cells(I, 3) = ""

End If

For m = 1 To Level

For I = 1 To ROWNUM

If Cells(I, 1) = m And Cells(I, 3) = "" Then

For j = I + 1 To ROWNUM

If Cells(j, 1) <= m Then

n = j - 1

Cells(I, 3).FormulaR1C1 = "=subtotal(9,R[1]C:R" & n & "C)"

Cells(I, 3).Interior.ColorIndex = 4

Exit For

End If

Cells(I, 3).FormulaR1C1 = "=subtotal(9,R[1]C:R" & ROWNUM & "C)"

Cells(I, 3).Interior.ColorIndex = 4

End If

End Sub

将上述代码复制到新建模块中，运行，结果如下，不仅生成层级展示，实现自动缩进，还能够自动判断公式的范围，如C7单元格公式为=SUBTOTAL(9,C8:C$11)，可以自动识别求和范围为第8行到第11行：

如果有问题，可以在评论区留言，欢迎转发、分享、点赞、收藏、打赏！

本文来自网友投稿或网络内容，如有侵犯您的权益请联系我们删除，联系邮箱：wyl860211@qq.com 。