然后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 IntegerDim 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 DictionaryFor i = 2 To UBound(arr)
   If Not d1.Exists(arr(i, 1)) Then
   d1(arr(i, 1)) = i
   End If
NextFor i = 2 To UBound(arr1)
   If Not d2.Exists(arr1(i, 1)) Then
   d2(arr1(i, 1)) = i
   End If
NextFor i = 2 To UBound(arr2)
   If Not d4.Exists(arr2(i, 1)) Then
   d1(arr2(i, 1)) = i
   End If
NextFor 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