Excel VBA - 运行时错误'9'，下标超出范围

Question

非常感谢我能得到的任何帮助。

我正在尝试遍历一列以查找重复名称，然后从同一行获取该数据和其他几个数据并将它们放入我想使用另一个函数的二维数组中，但它不起作用。

我真的需要你的帮助来弄清楚为什么我不能在不保留数据的情况下重新调整这个数组。

Dim oRange As Range, aCell As Range, bCell As Range
Dim ws As Worksheet
Dim SearchString As String, FoundAt As String
Dim tArray() As Variant
Dim iR As Long
Dim LastRow As Long
Dim LastCol As Long

'name of the worksheet
Set ws = Worksheets("VML Daily")

'column 6 has a huge list of names
Set oRange = ws.Columns(6)

'the keyword (there are 7 'ABC Company 1' in the column above)
SearchString = "ABC Company 1"

'Find keyword in column
Set aCell = oRange.Find(What:=SearchString, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)

'find last row and column number
LastRow = Range("A1").End(xlDown).Row

'redimensioning based on maximum rows
ReDim Preserve tArray(1 To LastRow, 1 To 3) As Variant

'if search finds something
If Not aCell Is Nothing Then
    Set bCell = aCell
    FoundAt = aCell.Address
    iR = 1

    tArray(1, 1) = aCell
    tArray(1, 2) = aCell.Offset(0, 33)
    tArray(1, 3) = aCell.Offset(0, 38)

    'continue finding stuff until end
    Do
        Set aCell = oRange.FindNext(After:=aCell)

        If Not aCell Is Nothing Then
            If aCell.Address = bCell.Address Then Exit Do
            FoundAt = FoundAt & ", " & aCell.Address
            tArray(iR, 1) = aCell
            tArray(iR, 2) = aCell.Offset(0, 33)
            tArray(iR, 3) = aCell.Offset(0, 38)
            iR = iR + 1
        Else
            Exit Do
        End If
    Loop

    'redim'ing the array to the amount of hits I found above and preserve the data
    'Here's where it error's out as "Subscript out of range"
    ReDim Preserve tArray(1 To iR, 1 To 3) As Variant
Else
    MsgBox SearchString & " not Found"
    Exit Sub
End If

Answer 1

你的第二个 Redim 不起作用，因为你正在做的事情是不可能的。

发件人：Excel VBA - How to Redim a 2D array?

在重新定义多维数组时，如果您想 保持你的价值观，你只能增加最后一个维度。

在调用Preserve 的同时更改数组的第一个元素总是会引发下标超出范围错误。

Sub Example()
    Dim val() As Variant
    ReDim val(1 To 2, 1 To 3)
    ReDim Preserve val(1 To 2, 1 To 4) 'Fine
    ReDim Preserve val(1 To 2, 1 To 2) 'also Fine
    ReDim Preserve val(1 To 3, 1 To 3) 'Throws error
    ReDim Preserve val(1 To 1, 1 To 3) 'Also throws error
End Sub

编辑：由于您实际上并没有更改最后一个维度，因此您只需交换要更改的维度即可重新编写代码。

例如：

ReDim Preserve tArray(1 To LastRow, 1 To 3) As Variant 和

ReDim Preserve tArray(1 To iR, 1 To 3) As Variant

成为

ReDim Preserve tArray(1 To 3, 1 To LastRow) As Variant 和

ReDim Preserve tArray(1 To 3, 1 To iR) As Variant

您只需要交换您在每次通话中使用的号码，它就会按预期工作。像这样：

tArray(1, iR) = aCell
tArray(2, iR) = aCell.Offset(0, 33)
tArray(3, iR) = aCell.Offset(0, 38)