Sub TEST_A1()
Dim Arr, Brr, xD, T$, i&, j%, R&, C&, S&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range("I1", [A65536].End(xlUp))
For i = 2 To UBound(Arr)
T = Arr(i, 3) & "|" & Arr(i, 8)
If Arr(i, 2) = [o10] Then xD(T) = xD(T) + 1
Next i
Arr = [n12].CurrentRegion
ReDim Brr(1 To UBound(Arr) - 1, 1 To UBound(Arr, 2) - 1)
R = UBound(Brr): C = UBound(Brr, 2)
For i = 1 To R - 1
For j = 1 To C - 1
S = xD(Arr(i + 1, 1) & "|" & Arr(1, j + 1))
Brr(i, j) = S
Brr(R, j) = Brr(R, j) + S
Brr(i, C) = Brr(i, C) + S
Brr(R, C) = Val(Brr(R, C)) + S
Next
Next
[o13].Resize(R, C) = Brr
End Sub
|