Excel VBA - 运行时错误'9'，下标超出范围 [英] Excel VBA - Run-time error '9', Subscript out of range

问题描述

我真的非常感谢任何帮助我可以得到这个。

I really appreciate any help I can get on this.

我试图循环查找重复的名称，然后采取和其他几个数据从同一行，将它们放入一个2D数组，我想使用另一个函数，但它不起作用。

I'm trying to loop through a column looking for duplicate names then taking that and several of other data from same row and placing them into an 2D array that I want to use another function, but it's not working.

我真的需要你的帮助，弄清楚为什么我无法重新设置数组，而不保存数据。

I really need your help figuring out why I cannot redim this array without preserving the data.

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

推荐答案

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

Your second Redim doesn't work because what you're doing is not possible.

From： Excel VBA - 如何重做二维数组？

当重新定标多维数组，如果要
保留您的值，您只能增加最后一个维度。

When Redimensioning multi-dimensional arrays, if you want to preserve your values, you can only increase the last dimension.

更改第一个元素您的数组，同时调用保存总是抛出一个下标超出范围错误。

Changing the first element of your array while also calling Preserve always throws a subscript out of range error.

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

编辑：由于您实际上没有更改最后一个维度，因此您可以通过交换代码

Since you aren't actually changing the last dimension, you can rework your code simply by swapping which dimension you're changing.

例如：

ReDim保存tArray（1到LastRow ，1到3）作为变体和

ReDim保存tArray（1到iR，1到3）作为变体

成为

ReDim保存tArray（1 To 3，1到LastRow）作为变式和

ReDim保存tArray（1到3，1到iR）As变体

您只需要交换每个通话中使用的号码，并且按照预期的方式工作。 LIKE so：

You'll just need to swap the numbers you use in each call, and it should work as expected. LIke so:

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

这篇关于Excel VBA - 运行时错误'9'，下标超出范围的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！