admin管理员组

文章数量:1609503

关注公众号：万能的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

 

本文标签： 并将表格制作教程Excel

版权声明：本文标题：Excel表格制作教程-合并相同项，并将对应的值求和 内容由热心网友自发贡献，该文观点仅代表作者本人， 转载请联系作者并注明出处：https://m.elefans.com/dongtai/1728569933a1164041.html， 本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌抄袭侵权/违法违规的内容，一经查实，本站将立刻删除。