将普通表变成交叉表

Sub zz()
    Dim d1 As New Dictionary, d2 As New Dictionary, d3 As New Dictionary, ar
    ar = Sheet1.Range("A1").CurrentRegion
    For i = 2 To UBound(ar)
        d1(ar(i, 2)) = ar(i, 3): d2(ar(i, 4)) = ar(i, 5)
        d3(ar(i, 4) & ar(i, 2)) = d3(ar(i, 4) & ar(i, 2)) + ar(i, 6)
    Next
    Application.ScreenUpdating = False
    With Sheet3
        .UsedRange.Cells.ClearContents
        .[a4].Resize(d2.Count, 2) = Application.Transpose(Array(d2.Keys, d2.Items))
        .[c2].Resize(1, d1.Count) = d1.Keys: .[c3].Resize(1, d1.Count) = d1.Items
        For i = 4 To d2.Count + 3
            For j = 3 To d1.Count + 2
                .Cells(i, j) = d3(.Cells(i, 1).Value & .Cells(2, j).Value)
            Next
        Next
    End With
    Application.ScreenUpdating = True
End Sub