字典计数求和、数据透视表、逆透视

https://www.cnblogs.com/Stefan-Gao/p/13642934.html 

Sub 数据透视汇总()

    Dim arr, brr, crr, dic1, dic2

    Dim i&, j&, k&, m&, n&

    Set dic1 = CreateObject('scripting.dictionary')

    Set dic2 = CreateObject('scripting.dictionary')

    arr = Range('a2:c' & Range('a' & Rows.Count).End(xlUp).Row)

    For i = 1 To UBound(arr)

        dic1(arr(i, 2)) = ''

    Next

    ReDim brr(1 To UBound(arr, 1), 1 To dic1.Count 1)

    ReDim crr(1 To dic1.Count)

    crr = dic1.keys

    For i = 1 To UBound(arr)

        For j = 0 To UBound(crr)

            If arr(i, 2) = crr(j) Then

                n = j 2

            End If

        Next

        If dic2.exists(arr(i, 1)) Then

            m = dic2(arr(i, 1))

            brr(m, n) = brr(m, n) arr(i, 3)

        Else

            k = k 1

            dic2(arr(i, 1)) = k

            brr(k, 1) = arr(i, 1)

            brr(k, n) = arr(i, 3)

        End If

    Next

    Range('g1').Resize(1, UBound(crr) 1) = crr

    Range('f2').Resize(k, n) = brr

    Erase arr

    Erase brr

    Erase crr

    Set dic1 = Nothing

    Set dic2 = Nothing

End Sub