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

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