下标超出范围 - 运行时错误9

时间:2015-10-10 21:43:20

标签: excel vba excel-vba runtime-error

这是我试图运行的代码:

Option Explicit

Sub Test()
'-------------Declarations-------------------
Dim FinalRow, Sum As Long
Dim i, j, l, d, k, count As Integer
Dim custID(), amtPur() As Long
Dim ws As Worksheet
Set ws = Sheets("Data")
FinalRow = ws.Range("B90000").End(xlUp).Row
j = 0

'-------------Get All the Data-------------------
With ws

For i = 4 To FinalRow
custID(j) = ws.Range("B" & i).Value   'Error Here
amtPur(j) = ws.Range("C" & i).Value   'Error Here
j = j + 1
Next i
End With

'-------------Match it and present the output----
l = 4
Dim wk As Worksheet
Set wk = Sheets("Results")

With wk
For j = 0 To FinalRow
     Sum = amtPur(j)

    'For the first iteration
     If j = 0 Then
        For k = j + 1 To FinalRow
        If custID(j) = custID(k) Then
        Sum = amtPur(k) + Sum
        Else: End If
        Next k
        wk.Range("A" & 3).Value = custID(j).Value
        wk.Range("B" & 3).Value = Sum

    Else: End If



           'For the rest iterations
           count = 0
           d = j
           Do While (d >= 0)
           If custID(d) = custID(j) Then
           count = count + 1
           Else: End If
           d = d - 1
           Loop

           If count <= 1 Then   'Check if instance was already found

           For k = j + 1 To FinalRow
           If custID(j) = custID(k) Then
           Sum = amtPur(k) + Sum
           Else: End If
           Next k
           wk.Range("A" & l).Value = custID(j).Text
           wk.Range("B" & l).Value = Sum

           l = l + 1


    End If


Next j
End With

End Sub

但不幸的是我得到了:

  

下标超出范围 - 运行时错误9

当我尝试运行它时。

2 个答案:

答案 0 :(得分:3)

虽然您已声明了custID()和amtPur()数组,但在使用它们之前,需要使用ReDim语句对它们进行初始化。在您的情况下,您将希望ReDim Preserve保留先前循环期间已存储在数组中的值:

Sub Test()
'-------------Declarations-------------------
Dim FinalRow, Sum As Long
Dim i As Integer
j As Integer
l As Integer
d As Integer
k As Integer
count As Integer
Dim custID() As Long, amtPur() As Long
Dim ws As Worksheet
Set ws = Sheets("Data")
FinalRow = ws.Range("B90000").End(xlUp).Row
j = 0

'-------------Get All the Data-------------------
With ws

For i = 4 To 100
ReDim Preserve custID(0 To j)
ReDim Preserve amtPur(0 To j)
custID(j) = ws.Range("B" & i).Value   'Error Here
amtPur(j) = ws.Range("C" & i).Value   'Error Here
j = j + 1
Next i
End With

End Sub

答案 1 :(得分:1)

嗯,似乎有点苛刻,这个问题已被低估了。你对VBA来说显然是新手,看起来你确实认为这是公平的。我钦佩那些通过反复试验学习的人 - 这肯定比许多第一张海报所做的更多 - 所以我想用一点背后的理论给你一个完整的答案:

  1. Dim - 如上所述,声明每种类型。避免使用与现有函数类似的名称,例如sum
  2. 如果您宣布自己的“阅读”字样。变量作为变量,您只需一行就可以从工作表中读取数据,并且数组将为您量身定制。您还可以在同一个数组中获取custIDamtPur。我在下面的代码中给出了一个名为custData的变量的例子。请注意,这些数组的基数为1而不是0。
  3. 您的With块是多余的。这些用于保存每次访问其属性时重复对象。在您的代码中,您重复该对象。我不是With块的忠实粉丝,但我已经在您的代码中添加了一个示例,以便您了解其工作原理。
  4. 您的If ... Else ... End If块有点混乱。逻辑应该If (case is true) Then做一些代码Else大小写是假的,所以做一些其他代码End If。我再次尝试重新编写代码,为您提供相关示例。
  5. 您在Range循环和循环Array时感到困惑。在您的代码中,您已将范围的限制设置为4 - FinalRow。但是,这并不意味着您的阵列已设置为相同的尺寸。最有可能的是,您的数组从0开始并转到FinalRow - 4.在循环之前,您需要清楚这些维度。
  6. 正如Mark Fitzgerald所提到的,在使用它之前,你需要dimension你的阵列。如果它是初始维度,那么您可以使用Redim。如果要在保留现有值的同时增加数组的维度,请使用Redim Preserve。我试图在下面的代码中给你一个例子。
  7. 好的,你的代码......

    由于循环,数组大小和If错误,很难看到您正在尝试做什么。我想您可能正在尝试读取所有客户ID,将它们写入唯一列表,然后汇总与每个ID匹配的所有值。下面的代码就是这样。它不是最快或最好的方式,但我尝试编写代码,以便您可以看到上述每个错误应该如何工作。我想如果我走错了道路并不重要,因为主要目的是让你了解如何管理数组,循环和If。我希望您的custIDamtPur真的是Long - 例如,amtPur代表&#39;已购买的金额&#39;并且实际上是一个十进制数,那么这段代码将抛出并出错,因此请确保您的值和声明属于同一类型。你的评论礼仪有点深奥,但我仍然遵循它。

    祝你的项目好运并坚持下去。我希望这会对你有所帮助:

    '-------------Declarations-------------------
    Dim dataSht As Worksheet
    Dim resultsSht As Worksheet
    Dim custData As Variant
    Dim uniqueIDs() As Long
    Dim summaryData() As Long
    Dim counter As Integer
    Dim isUnique As Boolean
    Dim rng As Range
    Dim i As Integer
    Dim j As Integer
    
    '-------------Get All the Data-------------------
    Set dataSht = ThisWorkbook.Sheets("Data")
    Set resultsSht = ThisWorkbook.Sheets("Results")
    With dataSht
        Set rng = .Range(.Cells(4, "B"), .Cells(.Rows.Count, "B").End(xlUp)).Resize(, 2)
    End With
    custData = rng.Value2 'writes worksheet to variant array
    
    '-------------Loop through the data to find number of unique IDs----
    For i = 1 To UBound(custData, 1)
    
        isUnique = True
    
        If i = 1 Then
            'First iteration so set the counter
            counter = 0
        Else
            'Subsequent iterations so check for duplicate ID
            For j = 1 To counter
                If uniqueIDs(j) = custData(i, 1) Then
                    isUnique = False
                    Exit For
                End If
            Next
        End If
    
        'Add the unique ID to our list
        If isUnique Then
            counter = counter + 1
            ReDim Preserve uniqueIDs(1 To counter)
            uniqueIDs(counter) = custData(i, 1)
        End If
    
    Next
    
    
    '-------------Aggregate the amtPur values----
    
    ReDim summaryData(1 To counter, 1 To 2)
    
    For i = 1 To counter
    
        summaryData(i, 1) = uniqueIDs(i)
    
        'Loop through the data to sum the values for the customer ID
        For j = 1 To UBound(custData, 1)
            If custData(j, 1) = uniqueIDs(i) Then
                summaryData(i, 2) = summaryData(i, 2) + custData(j, 2)
            End If
        Next
    
    Next
    
    '-----------Outpute the results to the worksheet----
    Set rng = resultsSht.Cells(4, 1).Resize(counter, 2)
    rng.Value = summaryData