求多列去重后求和代码

ykcbf1100

chenwenming 发表于 2023-4-12 12:59
结果不对啊

再猜一下。

全党

chenwenming 发表于 2023-4-12 12:59
结果不对啊

那是你没有表述明白，看看这是不是你要的结果

chenwenming

全党 发表于 2023-4-12 14:02
那是你没有表述明白，看看这是不是你要的结果

谢谢，结果正确

chenwenming

ykcbf1100 发表于 2023-4-12 13:57
再猜一下。

谢谢，结果正确

三分醉，七分醒

Sub 去重求和()
Dim 去重 As Object
Dim 求和 As Object
Dim arr, m%
arr = Sheet1.Range("a1").CurrentRegion
Set 去重 = CreateObject("scripting.dictionary")
Set 求和 = CreateObject("scripting.dictionary")
For m = 2 To UBound(arr)
   去重(arr(m, 1) & arr(m, 2) & arr(m, 3) & "-" & arr(m, 4)) = arr(m, 5)
Next
For Each d In 去重
    名称 = Split(d, "-")(1)
    求和(名称) = 求和(名称) + 去重(d)
Next d
求和_key = 求和.keys
求和_item = 求和.items
r = UBound(求和_key)
With WorksheetFunction
Sheet1.Range("h2").Resize(r, 1) = .Transpose(求和_key)
Sheet1.Range("i2").Resize(r, 1) = .Transpose(求和_item)
End With
End Sub

zxsea_7426

三分醉，七分醒 发表于 2023-4-12 15:01
Sub 去重求和()
Dim 去重 As Object
Dim 求和 As Object

就看代码就不符，字典你是一直更新的，楼主是第一次出现的计数并进行相关求和。