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?

當Redimensioning多維數組，如果你想保留 你的價值觀，你只能增加最後一個維度。

更改數組的第一個元素，同時調用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)