Question

用VBA数组字典进行多条件求和

用VBA数组字典进行多条件求和

Answer 1

解决方式见上图

Answer 2

Sub s()
    arr = [a1].CurrentRegion
    Set d = CreateObject("scripting.dictionary")
    k = 1
    For i = 2 To UBound(arr)
        t = arr(i, 1) & arr(i, 2)
        If Not d.exists(t) Then
            k = k + 1
            d(t) = k
            If k <> i Then
                arr(k, 1) = arr(i, 1)
                arr(k, 2) = arr(i, 2)
                arr(k, 3) = arr(i, 3)
            End If
        Else
            arr(d(t), 3) = arr(d(t), 3) + arr(i, 3)
        End If
    Next
    [f1].Resize(k, 3) = arr
End Sub