VBA：运行时错误：“9” 下标越界
然后d4的item应该和d1一样的，为什么d4出现的确是startT和endT的？ 下面黄色句子出现下标越界错误
Private Sub CommandButton1_Click()
Dim i As Integer, j As Integer, a As Integer, b As Integer
Dim arrA(1 To 60) As Double, arrB(1 To 60) As Double, arr, arr1, arr2
Dim arrC(1 To 60) As Double
Dim d1 As New Dictionary, d2 As New Dictionary
Dim d3 As New Dictionary
Dim d4 As New Dictionary
'Dim p As Integer
Dim StartT As Date, endT As Date
Application.DisplayAlerts = False
Application.ScreenUpdating = False
arr = Sheets("Jan").Range("A5:AJ" & Sheets("Jan").Range("A65536").End(xlUp).Row)
arr1 = Sheets("Jan").Range("AK2:AM" & Sheets("Jan").Range("AK2").End(xlDown).Row)
arr2 = Sheets("Jan").Range("A5:AF" & Sheets("Jan").Range("A65536").End(xlUp).Row)
Set d1 = New Dictionary
Set d2 = New Dictionary
Set d3 = New Dictionary
Set d4 = New Dictionary
For i = 2 To UBound(arr)
If Not d1.Exists(arr(i, 1)) Then
d1(arr(i, 1)) = i
End If
Next
For i = 2 To UBound(arr1)
If Not d2.Exists(arr1(i, 1)) Then
d2(arr1(i, 1)) = i
End If
Next
For i = 2 To UBound(arr2)
If Not d4.Exists(arr2(i, 1)) Then
d1(arr2(i, 1)) = i
End If
Next
For i = 1 To 6
If Not d2.Exists(arr1(i, 3)) Then
d3(arr1(i, 3)) = 0
End If
Next
StartT = Cells(17, 37)
endT = Cells(17, 38)
For j = 2 To UBound(arr, 2)
For i = d1(StartT) To d1(endT)
If IsNumeric(arr(i, j)) Then
If Not d2.Exists(arr(i, 1)) And Not Weekday(arr(i, 1)) = 1 And Not Weekday(arr(i, 1)) = 7 Then
arrA(j) = arrA(j) + arr(i, j) + 8
arrB(j) = arrB(j) + arr(i, j)
Else
arrA(j) = arrA(j) + arr(i, j)
arrB(j) = arrB(j) + arr(i, j)
End If
Else
If d3.Exists(arr(i, j)) Then
d3(arr(i, j)) = d3(arr(i, j)) + 1
End If
End If
Next
Next
For j = 2 To UBound(arr2, 2)
For i = d4(StartT) To d4(endT)
If IsNumeric(arr2(i, j)) Then If Not d2.Exists(arr2(i, 1)) And Not Weekday(arr2(i, 1)) = 1 And Not Weekday(arr2(i, 1)) = 7 Then
arrC(j) = arrC(j) + arr2(i, j) + 8
Else
arrC(j) = arrC(j) + arr2(i, j)
End If
End If
Next
Next
Cells(17, 40) = Application.Sum(arrC())
Cells(15, 40) = Application.Max(arrB())
Cells(15, 39) = Application.Sum(arrA())
Cells(2, 40).Resize(d3.Count) = Application.Transpose(d3.Items)
Set arr = Nothing
Set arr2 = Nothing
Set arr1 = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
[解决办法]
断点跟踪一下就好了
