Excel表格制作教程-合并相同项，并将对应的值求和

最新推荐文章于 2024-07-30 20:28:44 发布

置顶 Rubicon_Chen

最新推荐文章于 2024-07-30 20:28:44 发布

阅读量6k

点赞数 1

分类专栏： Excel 文章标签： Excel表格制作 VBS编程 Excel求和 Excel去除相同项 Excel编程

本文链接：https://blog.csdn.net/Rubicon_Chen/article/details/96844323

版权

Excel 专栏收录该内容

25 篇文章 29 订阅

订阅专栏

关注公众号：万能的Excel 并回复【自动求和】获取源文件！

功能要求：

工作中常常需要统计表格中每一项总和，人工筛选每一项总和需要耗费很大的精力

本工作簿实现的功能：

1、将相同ID号，相同物料的行合并

2、将同一个ID号的所有项都相加求和

附上代码：

Sub test1()
    Dim d1 As Object, d2 As Object, arr, i As Integer, k, brr
    Set d1 = CreateObject("scripting.dictionary")
    Set d2 = CreateObject("scripting.dictionary")
    Set d3 = CreateObject("scripting.dictionary")
    
    arr = Range("c4").CurrentRegion
    For i = 5 To UBound(arr)
        If Len(arr(i, 3)) Then
            If d1(arr(i, 3)) = "" Then  '如果是否有数据
                d1(arr(i, 3)) = arr(i, 9) '如果该关键字第一次出现
                d3(arr(i, 3)) = arr(i, 5)
                'MsgBox "关键字" & arr(i, 1) & Chr(13) & "条目" & d(arr(i, 1))
            Else '当该关键字出现了第二次以上
                d1(arr(i, 3)) = d1(arr(i, 3)) + arr(i, 9) '将原有的值加上新出现的值保存起来
                'MsgBox "关键字" & arr(i, 1) & Chr(13) & "条目" & d(arr(i, 1))
            End If
        End If
    Next i
    f = 5
    For Each k In d1.keys '遍历每一个关键字
        Cells(f, "l") = k
        Cells(f, "m") = d3(k)
        Cells(f, "n") = d1(k)
        f = f + 1
    Next k
    f = 0
   
End Sub