如何用VBA剔除列表中的重复项及求和

mai51

问题如下：

准提部林

將下面的"....."都刪去
Sub TEST_A1()
Dim Arr, xD, i&, j%, T1$, T2$, N&, R&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([D1], [A65536].End(3)): N = 1
For i = 2 To UBound(Arr)
    T1 = Arr(i, 1) & "|" & Arr(i, 2) & "|" & Arr(i, 3)
    T2 = T1 & "|" & Arr(i, 4)
    xD(T2) = xD(T2) + 1: If xD(T2) > 1 Then GoTo i01
    R = xD(T1)
    If R > 0 Then Arr(R, 4) = Arr(R, 4) + Arr(i, 4): GoTo i01
    N = N + 1: R = N: xD(T1) = N
    For j = 1 To 4: Arr(R, j) = Arr(i, j): Next
i01: Next i
With [J1].Resize(N, 4)
     .Value = Arr
     For j = 3 To 1 Step -1
        .Sort Key1:=.Item(j), Order1:=xlAscending, Header:=xlYes
     Next j
End With
End Sub

mai51

cui26896 发表于 2020-10-17 14:25
要审核，先发附件，请参考

老师，这结果怎么不对呀？见下图。

无敌小猪猪

用sql会不会简单点？

renkangjizhen

第一、二部字典可一次搞定，第三四部排序搞定

mai51

无敌小猪猪 发表于 2020-10-17 15:20
用sql会不会简单点？

这要外部链接，还是用VBA吧，处理时间应该不会快多少

mai51

cui26896 发表于 2020-10-17 15:19
排序漏了最后一行，重新上传了附件，请下载新的附近件。

老师，有个小问题帮忙追加一下，就是D列求和结果四舍五入只保留整数位，不要小数位了。我不太懂编码，劳烦老师帮忙修改一下。