VBA:error 9,下标越界。
Sub calculate()
Dim i As Integer, j As Integer, a As Integer, b As Integer
Dim arrA(1 To 40) As Double, arrB(1 To 40) As Double, arr, arr1, arr2, arr3
Dim d1 As New dictionary, d2 As New dictionary
Dim d3 As New dictionary
Dim d4 As Variant
Dim StartT As Variant, endT As Variant
'For i = 1 To Range("A65536").End(xlUp).Row
'arr(i) = Range("A" & i).Value
'Cells(i, 2) = arr(i)
'Next
'i = i + 1
Application.DisplayAlerts = False
Application.ScreenUpdating = False
arr = Sheets("Sheet1").Range("A2:H" & Sheets("Sheet1").Range("A65536").End(xlUp).Row)
arr1 = Sheets("Sheet1").Range("I2:J" & Sheets("Sheet1").Range("I2").End(xlDown).Row)
arr2 = Sheets("Sheet1").Range("B2:H33" & Sheets("Sheet1").Range("B2").End(xlDown).Row)
Set d1 = New dictionary
Set d2 = New dictionary
Set d3 = New dictionary
'ActiveSheet.Range("A1:H" & Sheets("Sheet1").Range("A65536").End(xlUp).Row).Select
For i = 2 To UBound(arr) 'get the value of all cells to arr
If Not d1.Exists(arr(i, 2)) Then
d1(arr(i, 2)) = i
End If
Next
For i = 2 To UBound(arr1) 'get the value of the date in A column to arr
If Not d2.Exists(arr1(i, 2)) Then
d2(arr1(i, 2)) = i
End If
Next
'For i = 2 To UBound(arr2) 'get the number of the value
'For j = 2 To UBound(arr2)
' If Not d3.Exists(arr2(i, 2)) Then
' d3(arr2(i, 2)) = [B2:H33]
' End If
'Next
'Next
StartT = Cells(17, 9)
endT = Cells(17, 10)
For j = 3 To UBound(arr, 2)
For i = d1(StartT) To d1(endT)
If Not d2.Exists(arr(i, 2)) 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
Next
Next
Cells(15, 12) = Application.Max(arrB())
Cells(15, 15) = Application.Sum(arrA())
Set arr = Nothing
Set arr1 = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub