Excel VBA – 运行时错误“9”，下标超出范围

我真的很感激任何帮助，我可以得到这一点。

我试图通过寻找重复的名称列，然后从同一行中的其他数据，并将其放置到一个二维数组，我想使用另一个function，但它不工作。

我真的需要你的帮助，搞清楚为什么我不能保存数据而不用重新定义这个数组。

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 – 如何Redim一个二维数组？

当Redimensioningmultidimensional 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)