老是提示“下标越界”，问题出在哪儿？

mijiayi

我在使用以下“多列一维转换多列二维交叉表”的VB的时候，老是提示“下标越界”，不知问题出在哪儿呢？请高手指点！
Private Sub CommandButton1_Click()
    Dim i%, c%, r%, d1 As Object, d2 As Object, rng, arr, arr1
    '[e4:l13].ClearContents
    Set d1 = CreateObject("Scripting.Dictionary")
    Set d2 = CreateObject("Scripting.Dictionary")
    With Sheet1    '.End(xlDown)
        nr = .[a65536].End(xlUp).Row
        rng = .Range("b2:l" & nr)
    End With
    ReDim arr(1 To nr, 1 To 3)
    For i = 1 To UBound(rng)
        k1 = rng(i, 1) & rng(i, 9) & rng(i, 11)
        k2 = rng(i, 2)
        If Not d1.exists(k1) Then d1.Add k1, c + 1: c = c + 1
        arr(c, 1) = rng(i, 1)
        arr(c, 2) = rng(i, 9)
        arr(c, 3) = rng(i, 11)
        If Not d2.exists(k2) Then d2.Add k2, r + 1: r = r + 1
    Next i
    'Sheet3.[a2].Resize(d1.Count, 1) = Application.Transpose(d1.keys)
    Sheet3.[a2].Resize(c, 3) = arr
    Sheet3.[d1].Resize(1, d2.Count) = d2.keys
    ReDim arr1(1 To nr, 1 To r + 1)
    For i = 1 To UBound(rng)
        k1 = rng(i, 1) & rng(i, 9) & rng(i, 11)
        k2 = rng(i, 2)
        arr1(d1(k1), d2(k2)) = arr1(d1(k1), d2(k2)) + rng(i, 11)
        arr1(i, 6) = arr1(i, 1) + arr1(i, 2) + arr1(i, 3) + arr1(i, 4) + arr1(i, 5)
    Next i
    Sheet3.[d2].Resize(UBound(rng), 6) = arr1
    Set d1 = Nothing
    Set d2 = Nothing
    MsgBox ("ok")
End Sub

hoogle

你上传附件，不然没办法调试

BAIXINGR

要看你的附件啊