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
[解决办法]
断点跟踪一下就好了