Question

我正在使用Excel VBA中的动态数组。列数（m）是固定的，但是，我不知道需要多少行（n）。

帮助文档声明ReDim Preserve myArray（n，m）允许我使m更大，但不能使n更大。但是，我需要在保留数据的同时增加行数（n），而不是列（m）！

例如，我可能有一个（5,20）数组，我想扩展到（10,20），同时保留我的数据。

似乎如果有某种方法来转置我的数组，做一个ReDim Preserve来扩展“列”的数量，然后重新转置我的数组，我可以完成我想要的。

这是正确的方法吗？如果是这样，我该怎么做？

有没有更好的方法来实现我想要的目标？

Answer 1

执行所需操作的一种方法是使用包含1-D数组而不是2-D数组的1-D数组。然后你可以ReDim保留你想要的外部数组。如果您从函数返回外部数组，Excel将执行正确的操作并将其强制转换为二维数组。

例如，下面的函数将返回一个3x2数组到它调用的单元格：

Public Function nested()
    Dim outer
    outer = Array(Array(1, 2), Array(3, 4))

    ReDim Preserve outer(1 To 3)

    outer(3) = Array(5, 6)

    nested = outer
End Function

我对这些问题的回答可能对您有用：Pass multidimensional array into Excel UDF in VBA和VBA pasting 3 dimensional array into sheet

当然，如果你不是从UDF返回这个，你必须自己强迫它。在不编写循环代码的情况下，这样做的简单方法是：

Dim coerced
coerced = Application.Index(outer, 0, 0)

这只是调用Excel的内置INDEX函数，而零意味着您需要返回所有行和所有列。 Excel会自动将1-D阵列的1-D阵列强制转换为2-D阵列。（警告：有一些尺寸限制，但它们比10x20大得多。）

Answer 2

你可以通过双转置改变两者之间的列数来实现它的一种方式。然而，这仅适用于二维阵列。它完成如下：

' Adding one row is done by a double transposing and adding a column in between.
' (Excel VBA does not allow to change the size of the non-last dimension of a
' multidimensional array.)
myArray = Application.Transpose(myArray)
ReDim Preserve myArray(1 To m, 1 To n + 1)
myArray= Application.Transpose(myArray)

当然m和n可以推断如下：

m = UBound(myArray, 1)
n = UBound(myArray, 2)

因此，您使用Excel本身的内置转置功能。正如代码注释中所提到的，这对高阶矩阵不起作用。

Answer 3

如果您是开发人员 - 行和列之间有什么区别？使用数组（N，2）（如果你有2列）与数组（2，N）相同 - 你可以

ReDim Preserve arr(1 to 2, 1 to N+1).

而你（作为开发人员）的不同之处在于将循环中的变量放在第二位，而不是第一位：

N = ubound(arr)
FOR i=1 to N
    GetColumn1Value = arr(1, i)
    GetColumn2Value = arr(2, i)
NEXT i

或者你想要这个：

N = ubound(arr)
FOR i=1 to N
    GetColumn1Value = arr(i, 1)
    GetColumn2Value = arr(i, 2)
NEXT i

有什么区别？

Answer 4

“转置”这个词立刻浮现在脑海中。您可以通过翻转列和行（即转置）简单地将数据输入到2D数组中，从而有效地允许您在需要时使n（现在的列数，但存储行值）更大。

引用值，比如在双循环中，交换索引。例如。而是从i = 1到n和j = 1到m，其中你引用值（i，j），使用i = 1到m，j = 1到n。

Answer 5

无法确定第一维中的元素数量？游民。对于具有固定第二维的二维数组，您可能需要考虑将其作为类型数组（在其他语言中使用“结构”）。这将允许您使用Redim Preserve，并且仍然以合理的方式添加和访问值，尽管您现在将作为Type的命名成员而不是索引值访问第二个维度。

Answer 6

解决了我自己的问题;这是我如何解决我的问题。我创建了一个临时数组，将myArray的内容复制到临时数组，调整myArray的大小，然后将内容从temp数组复制回myArray。

tempArray = myArray
ReDim myArray(1 To (UBound(myArray()) * 2), 1 To m)
For i = 1 To n
     For j = 1 To m
          myArray(i, j) = tempArray(i, j)
     Next j
Next i

如果有人能提出更有效的方法，我很乐意听到。

Answer 7

当数据大小跨越大于2 ^ 16行（~92000）时，

强制或切片似乎无法使用索引（或匹配（索引）（当我想基于多个条件过滤数组（无循环）时）行）。

Run-Time error '13':

Type Mismatch

转置不适用于大型记录集，因此双转置也不起作用。反正过滤数组并抓取数据而不诉诸多个循环？

我正在考虑使用Excel进行字典方式或ADO。

Answer 8

具有2个维度的数组，其中列数是固定的，行数是动态的，可以这样创建：

Sub test2DimArray()
Dim Arr2D() As String
Dim NumberOfCol As Long
Dim I As Long, J As Long, x As Long
Dim tmpValue As String, tmpValue2 As String, tmpValue3 As String

NumberOfCol = 3
J = 1
Debug.Print "Run " & Now()
Debug.Print "Sheet content"
Debug.Print "Row   col1     col2     col3"

For I = 1 To 10
tmpValue = Cells(I, 1).Value
tmpValue2 = Cells(I, 2).Value
tmpValue3 = Cells(I, 3).Value
Debug.Print I & " =    " & tmpValue & "     " & tmpValue2 & "     " & tmpValue3
    If Len(tmpValue) > 0 Then
        ReDim Preserve Arr2D(NumberOfCol, 1 To J)
        Arr2D(1, J) = tmpValue
        Arr2D(2, J) = tmpValue2
        Arr2D(3, J) = tmpValue3
        J = J + 1
    End If
Next

'check array values
Debug.Print vbLf; "arr2d content"
Debug.Print "Row   col1     col2     col3"

For x = LBound(Arr2D, 2) To UBound(Arr2D, 2)
Debug.Print x & " =   " & Arr2D(1, x) & "        " & Arr2D(2, x) & "        " & Arr2D(3, x)
Next

Debug.Print "========================="
End Sub

从单元格A1：A10读取TempValue，如果单元格Ax中有值，则用+1重新排列数组，并将Tempvalue添加到数组col1，将Bx中的内容添加到数组col2，将Cx中的内容添加到数组col3。如果Ax-value的长度为0，则不会向数组添加任何内容。

Debug.print在VB编辑器的“即时窗口”中显示结果。

没有测试行，并添加动态数据范围，代码可以是：

Sub my2DimArray()
Dim Arr2D() As String
Dim NumberOfCol As Long, NumberOfRow As Long
Dim FirstCol As Long, FirstRow As Long, LastCol As Long, LastRow As Long
Dim I As Long, J As Long, X As Long
Dim tmpValue As String, tmpValue2 As String, tmpValue3 As String

'if cells with values start in A1
With ActiveSheet.UsedRange
    NumberOfCol = .Columns.Count
    NumberOfRow = .Rows.Count
End With

'if cells with values starts elsewhere
With ActiveSheet.UsedRange
    FirstCol = .Column
    FirstRow = .Row
    LastCol = .Column + .Columns.Count - 1
    LastRow = .Row + .Rows.Count - 1
End With

J = 1

For I = 1 To NumberOfRow 'or For I = FirstRow to LastRow
tmpValue = Cells(I, 1).Value 'or tmpValue = Cells(I, FirstCol).Value
    If Len(tmpValue) > 0 Then
        ReDim Preserve Arr2D(NumberOfCol, 1 To J)
            For X = 1 To NumberOfCol 'or For X = FirstCol to LastCol
                Arr2D(X, J) = Cells(I, X).Value
            Next X
        J = J + 1
    End If
Next I

End Sub

如何在Excel 2007 VBA中“ReDim保留”2D数组，以便我可以向数组中添加行而不是列？

8 个答案: