本文于2023年9月9日首发于本人同名公众号：Excel活学活用，更多文章案例请搜索关注！

内容提要

一级科目提取科目汇总的3种方法

大家好，我是冷水泡茶，如果你是一名财务人员，少不了跟会计科目打交道，有一件经常要做的事就是“科目汇总”。

我们平时录入的凭证是一条条明细的记录，基本上每个月我们都要经历一次科目汇总的工作，进而编制各种财务报表。

有的科目直接以总账科目（一级科目）列示在报表中，比如应收账款、应付账款、其他应收款、其他应付款；

也有的科目是合并列示，比如现金+银行存款合并为货币资金；

还有的项目是以明细科目列示，比如管理费用明细表等。

今天给大家分享一个案例，根据末级科目余额表做出一级科目汇总表：

这也是网上VBA论坛的一个案例，我没有去回复，因为我觉得这事我们可以简单处理，没必要用VBA，可以用数据透视表、公式，当然，从学习研究VBA的角度，我们也用VBA做一个汇总，我们一起来看一看：

数据透视表法：

1、我们在E列加一个字段，“一级科目”。

2、我们输入公式，提取一级科目名称：

=IFERROR(TRIM(LEFT(B2,FIND("-",B2)-1)),B2)

公式解析：

（1）基本框架是用LEFT函数，把“-”前的文字提取出来；

（2）通过FIND函数，找到“-”的位置，我们把它减去1，作为LEFT函数的第2个参数。

（3）FIND函数中，如果没找到“-”，会返回错误值，我们基本可以认定，它就是一级科目。

（4）本例还有点特殊，科目名称中的“-”前后还有一个空格，我们用TRIM函数把它去掉。

3、我们插入数据透视表

经过检查，结果是正确的。有点不便之处就是，数据透视表的字段会进行排序，跟我们的科目顺序不同。如果仅仅用来汇总做报表，应该没什么影响，顺序无所谓；如果是要用来展示数据，比如做报告，那么这样就不太好了，我们可以在原始数据上面做点文章。

我们可以猜出，他的这个科目余额表应该是从某一个软件系统导出来的，那么，我们可以在导出数据的时候，把科目代码也导出来，或者，干脆把所有的能导出的字段都给它导出来，方便后续处理。

在我们前面分享过的财务记账模板中，就有一个名字为“汇总”的数据透视表，它是根据明细会计分录汇总的，道理是一样的，我们加入了科目代码，这样排序就没有问题了：

公式法

1、就着前面的表格，我们保留E列的“一级科目”

2、我们在F列，利用公式，取得E列一级科目的唯一值：

{=IFERROR(INDEX($E$2:$E$30,MATCH(0,COUNTIF($F$1:F1,$E$2:$E$30),0)),"")}

公式解析：参见【Excel 功能/公式函数/VBA/多种姿势处理重复值，你最喜欢哪种？】

3、我们在G2单元格，输入条件求和公式：

=SUMIFS($D$2:$D$29,$E$2:$E$29,$F2,$C$2:$C$29,LEFT(G$1,1))

公式解析：这个公式并不复杂，就是SUMIFS多条件求和的基本用法。这里我们要注意两个条件前面的$符号，$F2和G$1，还有，借贷方向在汇总表头是“借方”、“贷方“，而在数据源区域是“借”、“贷”，我们通过LEFT函数来处理一下，使之统一。

4、我们可以看到，结果也是正确的：

VBA代码法

1、在模块1，Sum汇总：

Sub Sum()    Dim ws As Worksheet    Dim lastRow As Integer    Dim dic As Object, dKey As String    Dim arr(), arr2()    Dim arrTotal()    Set ws = ThisWorkbook.ActiveSheet    Set dic = CreateObject("Scripting.Dictionary")    ReDim arrTotal(1)    With ws        lastRow = .UsedRange.Rows.Count        .Range("F2:H" & lastRow).ClearContents        arr = .Range("A2:D" & lastRow).Value        For i = 1 To UBound(arr)            If arr(i, 2) <> "" Then                dKey = Trim(Left(arr(i, 2), IIf(InStr(arr(i, 2), "-") = 0, Len(arr(i, 2)), InStr(arr(i, 2), "-") - 1)))                If dic.exists(dKey) Then                    arr2 = dic(dKey)                    If arr(i, 3) = "½è" Then                        arr2(0) = arr2(0) + arr(i, 4)                        arrTotal(0) = arrTotal(0) + arr(i, 4)                    Else                        arr2(1) = arr2(1) + arr(i, 4)                        arrTotal(1) = arrTotal(1) + arr(i, 4)                    End If                Else                    ReDim arr2(1)                    If arr(i, 3) = "½è" Then                        arr2(0) = arr(i, 4)                        arrTotal(0) = arrTotal(0) + arr(i, 4)                    Else                        arr2(1) = arr(i, 4)                        arrTotal(1) = arrTotal(1) + arr(i, 4)                    End If                End If                dic(dKey) = arr2                            End If        Next        dic("ºÏ¼Æ") = arrTotal        .Range("F2").Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(dic.keys)        .Range("G2").Resize(dic.Count, 2) = Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(dic.items))    End WithEnd Sub

代码解析：

（1）定义一些变量。

（2）line9，重定义数组arrTotal，用于存放借贷汇总金额。

（3）line13，把原始数据读入数组arr。

（4）line14~38，循环arr，把数据存入字典：

（A）line16，提取一级科目作为字典的key。

（B）line17~25，如果字典存在当前key值，则取得已存在item（它是一个2个元素的一维数组，第一个元素存借方金额，第二个元素存贷方金额），把当前的借方金额累加到arr2(0)，贷方金额累加到arr2(1)，同时把数据累加到arrTotal。

（C）line27~34，如果字典不存在当前key值，则重定义arr2(1)，把当前的借方金额赋值给arr2(0)，贷方金额赋值给arr2(1)，同时把数据累加到arrTotal。

（5）line36，把经过累加后的数组arr2赋值给字典。

（6）line39，把“合计”添加到字典。

（7）line40，把字典的keys（科目名称）写入工作表。

（8）line41，把字典的items（借贷方金额）写入工作表。

2、在工作表，CmdSum_Click汇总按钮

Private Sub CmdSum_Click()    Call SumEnd Sub

代码解析：调用Sum过程。

~~~~~~End~~~~~~

喜欢就点个赞、点在看、留个言、分享一下呗！感谢！