VBA--利用字典求和

Sub 字典汇总求和()


Dim arr, d As Object, brr()

Set d = CreateObject("scripting.dictionary")
arr = [a1].CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 3)
For i = 1 To UBound(arr)
 If Not d.exists(arr(i, 1)) Then
k = k + 1
d(arr(i, 1)) = k
 brr(k, 1) = arr(i, 1)
 brr(k, 2) = arr(i, 2)
brr(k, 3) = arr(i, 3)
Else
r = d(arr(i, 1)) '
brr(r, 2) = brr(r, 2) + arr(i, 2) '数量求和
brr(r, 3) = brr(r, 3) + arr(i, 3) '金额求和
End If
Next   '输出求和数据
[J1].Resize(k, 2) = brr
END SUB