用VBA实现Excel中数据的提取并且汇总

我想用图1的数据源自动生成图2的表格，能否用VBA实现？麻烦传一下代码，谢谢

例子数据源：

程序代码：

运行结果：

是不是很完美，程序文本：

Option Explicit

Sub 转换()

    Dim a1, a2(1 To 1000, 1 To 100), i, j, x, y, m, n

    Set x = CreateObject("Scripting.Dictionary")

    Set y = CreateObject("Scripting.Dictionary")

    a1 = Range("a1").CurrentRegion

    For i = 1 To UBound(a1)

        If a1(i, 1) = "ä»·æ ¼" Then

            If Not y.Exists(a1(i, 2)) Then

                a2(1, y.Count + 2) = a1(i, 2)

                y.Add a1(i, 2), y.Count + 2

            End If

            n = y(a1(i, 2))

        Else

            If Not x.Exists(a1(i, 1)) Then

                a2(x.Count + 2, 1) = a1(i, 1)

                x.Add a1(i, 1), x.Count + 2

            End If

            m = x(a1(i, 1))

            a2(m, n) = a1(i, 2)

        End If

    Next i

    Range("d1").Resize(x.Count + 1, y.Count + 1) = a2

End Sub

下标越界呢？

先估算一下数据，修改一下程序中的1000、100大一些