VBA: 一键合并重复数据，实现 Excel 行合并求和

Exploring

发布于 2025-04-21 00:03:55

22000

代码可运行

文章被收录于专栏：数据处理与编程实践数据处理与编程实践

运行总次数：0

代码可运行

文章背景： 在日常的数据处理中，我们经常会遇到这样的场景：一列是分类或名称，另一列是数值，有重复项，需要对这些重复项进行合并并求和。比如：

我们希望自动处理成这样：

今天给大家分享一个实用的 VBA 脚本，只需选择区域，点击运行，即可实现智能合并求和。

OptionExplicit

SubCombineRows()
    ' 智能合并重复行并求和
    DimWorkRngAsRange, iAsInteger
    DimDicAsVariant
    DimarrAsVariant

    ' 让用户选择区域
    SetWorkRng = Application.Selection
    SetWorkRng = Application.InputBox("Range", "选择区域", WorkRng.Address, Type:=8)

    ' 创建字典对象
    SetDic = CreateObject("Scripting.Dictionary")
    
    ' 将选中区域转为二维数组
    arr = WorkRng.Value

    ' 遍历每一行，把第一列作为 Key，第二列进行累加
    Fori = 1ToUBound(arr, 1)
        Dic(arr(i, 1)) = Dic(arr(i, 1)) +arr(i, 2)
    Next

    ' 更新界面前先关闭屏幕刷新，提高效率
    Application.ScreenUpdating = False

    ' 清空原区域
    WorkRng.ClearContents

    ' 把字典里的结果写回 Excel
    WorkRng.Range("A1").Resize(Dic.Count, 1) = Application.WorksheetFunction.Transpose(Dic.Keys)
    WorkRng.Range("B1").Resize(Dic.Count, 1) = Application.WorksheetFunction.Transpose(Dic.Items)

    ' 恢复屏幕刷新
    Application.ScreenUpdating = True
EndSub

(1) 对于arr = WorkRng.Value，Excel 的 Range 一旦包含多个单元格，返回的就是从 (1,1) 开始的二维数组，读取速度极快，适合大量数据处理。

(2) 借助字典结构自动去重，通过 Key 累加对应 Value，实现聚合求和。

参考资料：

[1] [Ready to Use 101 Powerful Excel VBA Code Just Copy - Paste - Run (For Functional Users)]

本文参与腾讯云自媒体同步曝光计划，分享自微信公众号。

原始发表：2025-04-20，如有侵权请联系 cloudcommunity@tencent.com 删除

vba