在动态多维数组 vba 中添加范围 data/cells

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 将始终 return I13:AG16384）。

我也不完全确定 m + 8 & "30:" & m + 8 & "75" 应该评估什么，因为每次循环都会增加变量 m，它会为您提供 930:975。我将在黑暗中试一试，并假设 m + 8 应该是您在其中找到该项目的列。

就是说，Range 对象的 .Value 属性只会给你一个二维数组。没有任何理由构建一个数组 - 只需构建一个范围，然后担心在完成后将数组从中取出。要合并范围（抓取它的值只能得到第一个区域），只需将其复制并粘贴到临时工作sheet，抓取数组，然后删除新的sheet.

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

在动态多维数组 vba 中添加范围 data/cells

Add range of data/cells in dynamic multidimensional array vba

arrays

vba

dynamic

multidimensional-array