在動態多維數組vba中添加數據/單元格范圍

Question

我希望能夠在動態多維數組中添加一定范圍的數據，而無需使用屏蔽該數組每個元素的雙循環。 但是我不知道是否可能。 通過雙循環，我的意思是這樣的代碼（這只是一個例子）：

Dim Films(1 To 5, 1 To 2) As String
Dim i As Integer, j As Integer 
For i = 1 To 5
     For j = 1 To 2
         Films(i, j) = Cells(i, j).Value
     Next j
Next i

我正在使用VBA2010。我知道我的數組有多少行，但是列數是可變的。

這是我的代碼：

Sub DRS(Item)
    'item is a name to search for in a specific range
    Dim SrcRange() As Variant
    Dim cell3 As Range
    Dim n As Integer, m As Integer

    SrcRange() = Array()
    ReDim SrcRange(45, 0)
    m = -1
    n = 0
    With Sheets("X")
        For Each cell3 In .Range("I13:AG" & .Cells(1, Columns.Count).End(xlToRight).Column)
        'the range ("I13:AG...") contains names, and some will match with "item"
            m = m + 1
            If Len(cell3.Value) > 0 And cell3 = Item Then 
                SrcRange(0, n) = .Range(m + 8 & "30:" & m + 8 & "75")
                'the previous line **should** add a whole range of cells (which contain numbers, one by cell) in a colum of the array, but this is the line that doesn't work.
                n = n + 1 
                ReDim Preserve SrcRange(UBound(SrcRange), n)
            End If
            Next cell3
    End With
End Sub

我已經嘗試過：

SrcRange(:, n) = .Range(m + 8 & "30:" & m + 8 & "75")
SrcRange(0:45, n) = .Range(m + 8 & "30:" & m + 8 & "75")
SrcRange(, n) = .Range(m + 8 & "30:" & m + 8 & "75")

但沒有人工作。

是否有一種方法或公式可以使我將整個單元格的范圍添加到數組的每一列，還是我必須使用雙循環來逐個添加元素？

Answer 1

我猜這個范圍...

.Range("I13:AG" & .Cells(1, Columns.Count).End(xlToRight).Column)

...實際上應該是xlToLeft而不是xlToRight（xlToRight將始終返回I13：AG16384）。

我也不完全確定應該將m + 8 & "30:" & m + 8 & "75"評估為什么，因為您每次在循環中都增加變量m ，它會為您提供如下范圍930：975。 我將在黑暗中刺傷，並假設m + 8應該是您在其中找到該項目的列。

也就是說，Range對象的.Value屬性將只為您提供一個二維數組。 確實沒有任何理由來構建數組-只需構建一個范圍，然后擔心在完成后將其移出數組。 要合並范圍（僅在獲取第一個區域時才獲得其值），只需將其復制並粘貼到臨時工作表中，獲取數組，然后刪除新表。

Sub DRS(Item)
    'item is a name to search for in a specific range
    Dim SrcRange() As Variant
    Dim found As Range
    Dim cell3 As Range

    With Sheets("X")
        For Each cell3 In .Range("I13:AG" & .Cells(1, Columns.Count).End(xlToLeft).Column)
            'the range ("I13:AG...") contains names, and some will match with "item"
            If Len(cell3.Value) > 0 And cell3.Value = Item Then
                If Not found Is Nothing Then
                    Set found = Union(.Range(.Cells(30, cell3.Column), .Cells(75, cell3.Column)), found)
                Else
                    Set found = .Range(.Cells(30, cell3.Column), .Cells(75, cell3.Column))
                End If
            End If
        Next cell3
    End With

    If Not found Is Nothing Then
        Dim temp_sheet As Worksheet
        Set temp_sheet = ActiveWorkbook.Sheets.Add
        found.Copy
        temp_sheet.Paste
        SrcRange = temp_sheet.UsedRange.Value
        Application.DisplayAlerts = False
        temp_sheet.Delete
        Application.DisplayAlerts = True
    End If
End Sub