vba 数组下标越界
Sub多列分项累计()Dimarr1()[f1].Resize(1,4)=(Range("a1:d1"))[j1]="次数"Setd=CreateObject("scri...
Sub 多列分项累计()
Dim arr1()
[f1].Resize(1, 4) = (Range("a1:d1"))
[j1] = "次数"
Set d = CreateObject("scripting.dictionary")
arr = Range("a2:d" & Cells(Rows.Count, 2).End(xlUp).Row)
For i = 1 To UBound(arr)
If Not d.Exists(arr(i, 1)) Then
n = n + 1
d(arr(i, 1)) = n
ReDim Preserve arr1(1 To n, 1 To 5) ‘此处越界,为什么?
arr1(n, 1) = arr(i, 1)
arr1(n, 2) = arr(i, 2)
arr1(n, 3) = arr(i, 3)
arr1(n, 4) = arr(i, 4)
arr1(n, 5) = 1
Else
m = d(arr(i, 1))
arr1(m, 2) = arr1(m, 2) + arr(i, 2)
arr1(m, 3) = arr1(m, 3) + arr(i, 3)
arr1(m, 4) = arr1(m, 4) + arr(i, 4)
arr1(m, 5) = arr1(m, 5) + 1
End If
Next
[f2].Resize(n, 5) = arr1()
End Sub 展开
Dim arr1()
[f1].Resize(1, 4) = (Range("a1:d1"))
[j1] = "次数"
Set d = CreateObject("scripting.dictionary")
arr = Range("a2:d" & Cells(Rows.Count, 2).End(xlUp).Row)
For i = 1 To UBound(arr)
If Not d.Exists(arr(i, 1)) Then
n = n + 1
d(arr(i, 1)) = n
ReDim Preserve arr1(1 To n, 1 To 5) ‘此处越界,为什么?
arr1(n, 1) = arr(i, 1)
arr1(n, 2) = arr(i, 2)
arr1(n, 3) = arr(i, 3)
arr1(n, 4) = arr(i, 4)
arr1(n, 5) = 1
Else
m = d(arr(i, 1))
arr1(m, 2) = arr1(m, 2) + arr(i, 2)
arr1(m, 3) = arr1(m, 3) + arr(i, 3)
arr1(m, 4) = arr1(m, 4) + arr(i, 4)
arr1(m, 5) = arr1(m, 5) + 1
End If
Next
[f2].Resize(n, 5) = arr1()
End Sub 展开
2个回答
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询