求助，vba多条件汇总求和

lcshang0520

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim a, ss, m
arr = Range("A2").CurrentRegion
Dim d As Object
Set d = CreateObject("Scripting.Dictionary")   

For a = 2 To UBound(arr)
    If arr(a, 5) <> "EE" Then
        Cells(a, 7) = Split(arr(a, 6), ";")(0)
    Else

        For n = 2 To a
        ss = arr(n, 1) & arr(n, 3) & arr(n, 4)
        If arr(a, 1) = arr(n, 1) And arr(a, 4) = arr(n, 4) And arr(a, 6) <> arr(n, 6) And arr(n, 5) = "AA" Or arr(n, 5) = "BB" Or arr(n, 5) = "CC" Then
        d(ss) = d(ss) + Split(arr(n, 6), ";")(0)
        ElseIf arr(a, 1) = arr(n, 1) And arr(a, 4) = arr(n, 4) And arr(a, 6) = arr(n, 6) And arr(n, 5) = "AA" Or arr(n, 5) = "BB" Or arr(n, 5) = "CC" Then
        d(ss) = Split(arr(n, 6), ";")(0)
        End If
        Next
        Cells(a, 7) = d(ss)
    End If
Next
End Sub


字典用法用得不好，求不出背景黄色标出的结果，请各位老师教教我，谢谢！

microyip

等于EE时，ss是什么，没指定

lcshang0520

microyip 发表于 2018-9-7 14:07
等于EE时，ss是什么，没指定

我字典用得不好，能教教我吗？谢谢

lcshang0520

哪位老师能帮我看看吗，谢谢

lcshang0520

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim a, ss, m
arr = Range("A2").CurrentRegion
Dim d As Object
Set d = CreateObject("Scripting.Dictionary")   

For a = 2 To UBound(arr)
    If arr(a, 5) <> "EE" Then
        Cells(a, 7) = Split(arr(a, 6), ";")(0)
    Else

        For n = 2 To a
        ss = arr(n, 1) & arr(n, 3) & arr(n, 4)
        If arr(a, 1) = arr(n, 1) And arr(a, 4) = arr(n, 4) And arr(a, 6) <> arr(n, 6) And arr(n, 5) = "AA" Or arr(n, 5) = "BB" Or arr(n, 5) = "CC" Then
        d(ss) = d(ss) + Split(arr(n, 6), ";")(0)
        ElseIf arr(a, 1) = arr(n, 1) And arr(a, 4) = arr(n, 4) And arr(a, 6) = arr(n, 6) And arr(n, 5) = "AA" Or arr(n, 5) = "BB" Or arr(n, 5) = "CC" Then
        d(ss) = Split(arr(n, 6), ";")(0)
        End If
        Next
        Cells(a, 7) = d(ss)
    End If
Next
End Sub
这个split拆分要怎么求和？