首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VB >

VBA:error 九,下标越界

2013-06-25 
VBA:error 9,下标越界。Sub calculate()Dim i As Integer, j As Integer, a As Integer, b As IntegerDim a

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


[解决办法]
看下你工作表的名字和代码里的是不是一致的
[解决办法]
先看看arr的数组有多大,下标越界后看看i和j的值。

热点排行