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

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

功能要求:

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

本工作簿实现的功能:

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

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

 

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

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

附上代码:

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

 

    原文作者:Rubicon_Chen
    原文地址: https://blog.csdn.net/Rubicon_Chen/article/details/96844323
    本文转自网络文章,转载此文章仅为分享知识,如有侵权,请联系博主进行删除。
点赞