VBA求和

Sub test()
    Dim arr, brr
    Dim d As Object
    Dim k%, i%, m%, str$,str1$

arr = Sheets(“sheet1”).Range(“a1”).CurrentRegion
    brr = Sheets(“sheet2”).Range(“a2”).CurrentRegion
    Set d = CreateObject(“scripting.dictionary”)

For k = 2 To UBound(arr)
        str = arr(k, 1) & arr(k, 3) & arr(k, 2)
        If Not d.exists(str) Then
            d(str) = arr(k, 4)
        Else
            d(str) = d(str) + arr(k, 4)
        End If
    Next k
    For i = 2 To UBound(brr)
        For m = 3 To UBound(brr, 2)
            str1 = brr(i, 1) & brr(i, 2) & brr(1, m)
            brr(i, m) = d(str1)
        Next m
    Next i

Sheets(“sheet2”).Range(“a2”).Resize(UBound(brr), UBound(brr, 2)) = brr
End Sub