admin管理员组文章数量:1609530
关注公众号:万能的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表格制作教程-合并相同项,并将对应的值求和 内容由热心网友自发贡献,该文观点仅代表作者本人, 转载请联系作者并注明出处:https://www.elefans.com/dongtai/1728569933a1164041.html, 本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌抄袭侵权/违法违规的内容,一经查实,本站将立刻删除。
发表评论