求助，多条件不重复个数求和

'源数据可以无序
Option Explicit
Sub abc()
　Dim a, i, j, p, m, n, d(1)
　a = Range("a2:c" & [a2].End(xlDown).Row + 1).Value
　ReDim b(UBound(a), 31)
　Call bsort(a, 1, UBound(a) - 1, 1, 3, 1)
　For i = 0 To UBound(d)
　　Set d(i) = CreateObject("scripting.dictionary")
　Next
　For i = 1 To UBound(a) - 1
　　If a(i, 1) <> a(i + 1, 1) Then
　　　m = m + 1: b(m, 0) = a(i, 1)
　　　Call bsort(a, p + 1, i, 2, 3, 3)
　　　For j = p + 1 To i
　　　　d(0)(a(j, 2)) = 1
　　　　If a(j, 3) <> a(j + 1, 3) Or j = i Then
　　　　　If Not d(1).exists(a(j, 3)) Then
　　　　　　n = n + 1
　　　　　　d(1)(a(j, 3)) = n: b(0, n) = a(j, 3)
　　　　　End If
　　　　　b(m, d(1)(a(j, 3))) = d(0).Count: d(0).RemoveAll
　　　　End If
　　　Next
　　　p = i
　　End If
　Next
　[e2].Resize(UBound(b) + 1, UBound(b, 2) + 1) = b
End Sub
Function bsort(a, first, last, left, right, key)
　Dim i, j, k, t
　For i = first To last - 1
　　For j = first To last + first - 1 - i
　　　If a(j, key) > a(j + 1, key) Then
　　　　For k = left To right
　　　　　t = a(j, k): a(j, k) = a(j + 1, k): a(j + 1, k) = t
　　　　Next
　　　End If
　　Next
　Next
End Function