Excel VBA - 运行时错误“9”，下标超出范围
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/20667785/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel VBA - Run-time error '9', Subscript out of range
提问by Humble Val
I really appreciate any help I can get on this.
我真的很感激我能得到的任何帮助。
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
回答by Daniel
Your second Redim doesn't work because what you're doing is not possible.
你的第二个 Redim 不起作用，因为你在做什么是不可能的。
From: Excel VBA - How to Redim a 2D array?
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 Preservealways throws a subscript out of range error.
在调用的同时更改数组的第一个元素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
Edit: Since you aren't actually changing the last dimension, you can rework your code simply by swapping which dimension you're changing.
编辑：由于您实际上并未更改最后一个维度，因此您只需交换要更改的维度即可重新编写代码。
For instance:
例如：
ReDim Preserve tArray(1 To LastRow, 1 To 3) As Variantand
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 iR, 1 To 3) As Variant
become
变得
ReDim Preserve tArray(1 To 3, 1 To LastRow) As Variantand
ReDim Preserve tArray(1 To 3, 1 To LastRow) As Variant和
ReDim Preserve tArray(1 To 3, 1 To iR) As Variant
ReDim Preserve tArray(1 To 3, 1 To iR) As Variant
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)
