在动态多维数组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

我使用的是 VBA 2010。我知道我的数组有多少行，但列数是可变的。

这是我的代码：

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