从0学Excel VBA编程 · 番外篇4:合并后自动去重/按列汇总——字典让统计一步到位
学习目标
分清"去重"和"按列汇总"两件事:一个取唯一清单,一个按组求和 用字典(Dictionary)的 Exists/Add/Item 累加实现这两件事通过 3 个实战案例,做出合并后自动去重、按产品汇总销量、合并+汇总一条龙的小工具
知识点精讲
番外篇我们学过字典(像电话簿,键不重复);番外篇3 学过批量合并多张表。现在把它们合体——合并完往往还要"收拾"两下:
去重:十几个分公司报上来的表里,客户"张三"出现了 8 次,你只想要一份"不重复客户名单"。→ 把"客户名"当键 Add进字典,重复的Exists会被挡掉,最后把字典.Keys倒出来就是唯一清单。按列汇总:想算每个产品的总销量。→ 把"产品名"当键,"销量"当值;遇到同一个产品, 字典(产品) = 字典(产品) + 本次销量累加;最后输出"产品 → 合计"。
一句话记牢:去重取 Keys,汇总用 Item。
前置约定:本篇假设"汇总"表已经存在(可由番外篇3 合并生成),表头在第 1 行、数据从第 2 行起。案例中"第几列"按示例位置写,你的真实表格列位置不同,改一下
Cells(i, 列号)里的列号即可。
3 个实战案例
案例 1(简单):合并后按"客户名称"列去重,生成唯一客户清单
功能说明:把"汇总"表里第 1 列的"客户名称"全部去重,唯一值列到新表"客户清单"。下次发通知、做对账,直接用这份名单。
操作步骤:
确保本工作簿有"汇总"表(第 1 列是客户名,第 1 行是表头)。 按 Alt + F11打开 VBA 编辑器,插入「标准模块」。粘贴下面代码,运行"按列去重生成客户清单"。 看自动生成的"客户清单"表,已是不重复的客户名。
Sub 按列去重生成客户清单() Dim 字典 As Object Dim 末行 As Long, i As Long Dim 客户 As String Dim 源表 As Worksheet, 结果表 As Worksheet Dim 键 As Variant, r As Long Set 字典 = CreateObject("Scripting.Dictionary") Set 源表 = ThisWorkbook.Sheets("汇总") On Error Resume Next Set 结果表 = ThisWorkbook.Sheets("客户清单") On Error GoTo 0 If 结果表 Is Nothing Then Set 结果表 = ThisWorkbook.Sheets.Add 结果表.Name = "客户清单" End If 结果表.Cells.Clear 结果表.Range("A1").Value = "客户名称" 末行 = 源表.Cells(源表.Rows.Count, 1).End(xlUp).Row For i = 2 To 末行 ' 从第2行(跳过表头)开始 客户 = 源表.Cells(i, 1).Value If 客户 <> "" Then If Not 字典.Exists(客户) Then 字典.Add 客户, 1 ' 值随意,我们要的是键(唯一客户) End If End If Next i r = 2 For Each 键 In 字典.Keys 结果表.Cells(r, 1).Value = 键 r = r + 1 Next 键 MsgBox "去重完成,共 " & 字典.Count & " 个不重复客户。", vbInformationEnd Sub要点:
Exists判断防止重复Add报错——字典的"键不能重复"正是去重的天然保障;最后For Each 键 In 字典.Keys把唯一键逐行倒出。若你的客户名在第 2 列,把Cells(i, 1)改成Cells(i, 2)。
案例 2(中等):合并后按"产品"分组,把"数量"列求和
功能说明:把"汇总"表按第 1 列"产品"分组,把第 2 列"数量"累加,生成"产品汇总"表(产品 → 数量合计)。比 Excel 数据透视表写代码更可控,还能嵌进你的自动化流程。
操作步骤:
确保"汇总"表第 1 列是产品、第 2 列是数量(第 1 行是表头)。 粘贴下面代码(与案例 1 同模块即可),运行"按产品汇总数量"。 看"产品汇总"表,每种产品一行,数量已合计。
Sub 按产品汇总数量() Dim 字典 As Object Dim 末行 As Long, i As Long Dim 产品 As String, 数量 As Double Dim 源表 As Worksheet, 结果表 As Worksheet Dim 键 As Variant, r As Long Set 字典 = CreateObject("Scripting.Dictionary") Set 源表 = ThisWorkbook.Sheets("汇总") On Error Resume Next Set 结果表 = ThisWorkbook.Sheets("产品汇总") On Error GoTo 0 If 结果表 Is Nothing Then Set 结果表 = ThisWorkbook.Sheets.Add 结果表.Name = "产品汇总" End If 结果表.Cells.Clear 结果表.Range("A1").Value = "产品" 结果表.Range("B1").Value = "数量合计" 末行 = 源表.Cells(源表.Rows.Count, 1).End(xlUp).Row For i = 2 To 末行 产品 = 源表.Cells(i, 1).Value ' 第1列=产品 If 产品 <> "" Then 数量 = Val(源表.Cells(i, 2).Value) ' 第2列=数量,Val把文本转数字 If 字典.Exists(产品) Then 字典(产品) = 字典(产品) + 数量 ' 已存在→累加 Else 字典.Add 产品, 数量 ' 首次出现→新增 End If End If Next i r = 2 For Each 键 In 字典.Keys 结果表.Cells(r, 1).Value = 键 结果表.Cells(r, 2).Value = 字典(键) r = r + 1 Next 键 MsgBox "汇总完成,共 " & 字典.Count & " 种产品。", vbInformationEnd Sub要点:
Val(...)把单元格文本稳妥转成数字,空白或文本不会让累加崩掉;字典(产品) = 字典(产品) + 数量是"按列汇总"的核心——键相同就累加值。换列只需改Cells(i, 1)(分组列)和Cells(i, 2)(求和列)的列号。
案例 3(实用小案例):一条龙——先合并文件夹,再按"产品"汇总销量
功能说明:把番外篇3 的"合并"和本篇的"汇总"串成一个按钮:先在「待合并」文件夹合并所有 Excel 到"汇总"表,再按第 1 列"产品"、第 3 列"销量"汇总到"销量汇总"表。全程一键,无需手工步骤衔接。
操作步骤:
把本工作簿保存到某文件夹,旁边建「待合并」文件夹并放入结构相同的 Excel(第 1 列=产品,第 3 列=销量)。 粘贴下面代码,运行"合并并汇总销量"。 看"汇总"表(合并明细)和"销量汇总"表(按产品合计)都已生成。
Sub 合并并汇总销量() Dim fso As Object, 文件夹 As Object, 文件 As Object Dim 源表 As Worksheet, 源簿 As Workbook, 总表 As Worksheet Dim 字典 As Object, 末行 As Long, 源末行 As Long, 列数 As Long Dim 是首份 As Boolean, i As Long Dim 产品 As String, 销量 As Double Dim 结果表 As Worksheet, 键 As Variant, r As Long ' —— 第一步:FSO 合并(同番外篇3) —— On Error Resume Next Set 总表 = ThisWorkbook.Sheets("汇总") Set 结果表 = ThisWorkbook.Sheets("销量汇总") On Error GoTo 0 If 总表 Is Nothing Then Set 总表 = ThisWorkbook.Sheets.Add 总表.Name = "汇总" End If If 结果表 Is Nothing Then Set 结果表 = ThisWorkbook.Sheets.Add 结果表.Name = "销量汇总" End If 总表.Cells.Clear 是首份 = True Set fso = CreateObject("Scripting.FileSystemObject") Set 文件夹 = fso.GetFolder(ThisWorkbook.Path & "\待合并") For Each 文件 In 文件夹.Files If LCase(fso.GetExtensionName(文件.Name)) = "xlsx" Then Set 源簿 = Workbooks.Open(文件.Path) Set 源表 = 源簿.Sheets(1) 源末行 = 源表.Cells(源表.Rows.Count, 1).End(xlUp).Row If 源末行 > 1 Then If 是首份 Then 列数 = 源表.UsedRange.Columns.Count 源表.Range("A1").Resize(源末行, 列数).Copy 总表.Range("A1") 是首份 = False Else 源表.Range("A2").Resize(源末行 - 1, 列数).Copy _ 总表.Cells(总表.Rows.Count, 1).End(xlUp).Offset(1, 0) End If End If 源簿.Close False End If Next 文件 ' —— 第二步:字典按"产品"(第1列)汇总"销量"(第3列) —— Set 字典 = CreateObject("Scripting.Dictionary") 末行 = 总表.Cells(总表.Rows.Count, 1).End(xlUp).Row For i = 2 To 末行 产品 = 总表.Cells(i, 1).Value If 产品 <> "" Then 销量 = Val(总表.Cells(i, 3).Value) ' 第3列=销量 If 字典.Exists(产品) Then 字典(产品) = 字典(产品) + 销量 Else 字典.Add 产品, 销量 End If End If Next i 结果表.Cells.Clear 结果表.Range("A1").Value = "产品" 结果表.Range("B1").Value = "销量合计" r = 2 For Each 键 In 字典.Keys 结果表.Cells(r, 1).Value = 键 结果表.Cells(r, 2).Value = 字典(键) r = r + 1 Next 键 MsgBox "合并 " & (末行 - 1) & " 行,汇总为 " & 字典.Count & " 种产品。", vbInformationEnd Sub要点:前半段就是番外篇3 的合并逻辑(首份留表头、其余
A2起复制、Close False);后半段复用案例 2 的字典累加。两件事用同一个"汇总"表衔接,无需中间手工操作。换成"按部门汇总工资""按地区汇总金额",只改分组列号(第 1 列)与求和列号(第 3 列)即可。
本篇小结
去重 vs 汇总:去重 = 取唯一清单( 字典.Keys);按列汇总 = 分组求和(字典(键) = 字典(键) + 值)。字典两板斧: Exists先判断防重复Add;Item累加做求和。这正是番外篇"电话簿"的实战落地。列位置要认准:分组列、求和列的 Cells(i, 列号)按你的真实表格改,别照抄示例列号。一条龙可行:番外篇3 的"合并" + 本篇的"字典处理"可以拼进同一个过程,合并完立刻统计,全程一键。 铁律:先 Exists再Add;累加前用Val把文本转数字,避免空白/文本让累加出错。
下一篇内容预告
本篇是《从0学Excel VBA编程》番外篇4(去重/按列汇总)。字典 + FSO 合并的组合,已经能覆盖"多文件收集 → 清洗 → 统计"的完整链路。下一篇可选:
番外篇5:在 VBA 里用 SQL——直接对表格写 SELECT做筛选汇总,比循环更清爽;或 番外篇5:把结果自动导出/邮件发送——合并汇总完,自动存成新文件或用 Outlook 发出去。 需要哪个,告诉我就行。
夜雨聆风