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

admin管理员组

文章数量:1438920

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

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

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

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

代码语言：javascript代码运行次数：0运行复制

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 删除vba数据处理excel数据数组

本文标签： VBA 一键合并重复数据，实现 Excel 行合并求和