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

Question

这是我正在尝试的代码运行：

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

但不幸的是我得到了：

Subscript out of Range - Run time error 9

当我尝试运行时。

Answer 1

虽然您已经声明了 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

Answer 2

嗯，这个问题被否决似乎有点苛刻。您显然是 VBA 的新手，而且您似乎已经做到了这一点。我钦佩通过反复试验学习的人 - 这肯定比许多第一张海报做的要多 - 所以我想给你一个非常完整的答案，其中包含一些背后的理论：

Dim - 如前所述，声明每种类型。避免使用与现有函数相似的名称，例如 sum.
如果您将 'read' 变量声明为变体，则只需一行即可从工作表中读取数据，数组将为您确定尺寸。您还可以在同一数组中获取 custID 和 amtPur。我在下面的代码中的一个名为 custData 的变量中为您提供了这方面的示例。请注意，这些数组的基数是 1 而不是 0。
您的 With 块是多余的。这些是为了避免您每次访问其属性时都重复该对象。在您的代码中，您重复该对象。我不是 With 块的超级粉丝，但我在您的代码中放了一个示例，以便您了解它是如何工作的。
你的If ... Else ... End If块有点乱。逻辑应该是 If (case is true) Then 做一些代码 Else 情况是错误的，所以做一些其他代码 End If。同样，我尝试重新编写您的代码来为您提供这方面的示例。
您混淆了 Range 循环和 Array 循环。在您的代码中，您已将范围的限制设置为 4 - FinalRow。但是，这并不意味着您的数组已设置为相同的维度。最有可能的是，你的数组从 0 开始到 FinalRow - 4。你需要在循环之前清楚这些维度。
正如 Mark Fitzgerald 提到的，您需要 dimension 您的数组才能使用它。如果它是初始维度，那么您可以只使用 Redim。如果您想在保留现有值的同时增加数组的维度，请使用 Redim Preserve。我已尝试在下面的代码中为您提供两者的示例。

好的，开始你的代码...

由于循环、数组大小和 If 错误，很难看出您要做什么。我认为您可能正在尝试读取所有客户 ID，将它们写入一个唯一列表，然后将与每个 ID 匹配的所有值相加。下面的代码就是这样做的。这不是最快或最好的方法，但我已经尝试编写代码，以便您可以看到上面的每个错误应该如何工作。我想如果我走错了路也没关系，因为主要目的是让您了解如何管理数组、循环和 Ifs。我希望你的 custID 和 amtPur 是真正的 Longs - 例如，如果 amtPur 代表 'amount purchased' 并且实际上是一个十进制数那么此代码将抛出错误，因此请确保您的值和声明属于同一类型。你的评论礼仪有点深奥，但我还是遵守了。

祝你的项目好运并坚持下去。希望对您有所帮助：

'-------------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

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

Subscript out of Range - Run time error 9

excel

vba

runtime-error

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

Subscript out of Range - Run time error 9

excel

vba

runtime-error

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