繁体   English   中英

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

[英]Subscript out of Range - Run time error 9

我正在尝试运行的代码:

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

当我尝试运行它时。

在声明了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

嗯,这个问题被否决了似乎有点刺耳。 显然您是VBA的新手,而且您似乎也很高兴。 我很欣赏通过反复试验而学习的人-当然,它比许多最初的发贴人所能做的还要多-因此,我想用一些背后的理论为您提供完整的答案:

  1. Dim -如前所述,声明每种类型。 避免使用类似于现有功能的名称,例如sum
  2. 如果将“ read”变量声明为变量,则只需一行就可以从工作表中读取数据,并且将为您确定数组的大小。 您还可以在同一阵列中获取custIDamtPur 我在下面的代码中通过一个名为custData的变量为您提供了一个示例。 请注意,这些数组的底数为1而不是0。
  3. 您的With块是多余的。 这些是为了避免您每次访问对象属性时重复对象。 在您的代码中重复对象。 我不是With块的忠实拥护者,但是我在您的代码中放了一个示例,以便您了解它的工作原理。
  4. 您的If ... Else ... End If块有点混乱。 逻辑应该为If (case is true) Then执行一些代码, Else为false, End If执行其他代码。 同样,我尝试重新编写您的代码,以提供示例。
  5. 您在遍历RangeArray感到困惑。 在您的代码中,您已将范围的限制设置为4- FinalRow 但是,这并不意味着您的数组已设置为相同的尺寸。 您的数组最有可能从0开始,然后转到FinalRow -4。在循环之前,需要清楚这些尺寸。
  6. 正如Mark Fitzgerald所提到的,您需要在使用数组之前确定其dimension 如果是初始尺寸,则可以使用Redim 如果要在保留现有值的同时增加数组的尺寸,请使用Redim Preserve 我尝试在下面的代码中为您提供这两个示例。

好的,那么到您的代码...

有了循环,数组大小和“ If出错”,很难知道您要执行的操作。 我认为您可能正在尝试读取所有客户ID,将它们写入唯一列表,然后将与每个ID匹配的所有值相加。 下面的代码可以做到这一点。 这不是最快或最好的方法,但是我尝试编写代码,以便您可以看到上述每个错误的工作方式。 我想我走错路都没关系,因为主要目的是让您了解如何管理数组,循环和If 我希望您的custIDamtPur确实是Long s-例如,如果amtPur代表“已购买金额”,并且实际上是一个十进制数字,那么此代码将抛出错误,因此请确保您的值和声明的相同的类型。 您的评论礼仪有些深奥,但我仍然遵循。

祝您的项目好运,并继续努力。 我希望这可以帮助你:

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

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM