在 Visual Basic 6 中 ReDim 保留到多维数组答案

【问题标题】：ReDim Preserve to a Multi-Dimensional Array in Visual Basic 6在 Visual Basic 6 中 ReDim 保留到多维数组
【发布时间】：2013-05-04 00:01:03
【问题描述】：

我正在使用 VB6，我需要对多维数组进行 ReDim Preserve：

 Dim n, m As Integer
    n = 1
    m = 0
    Dim arrCity() As String
    ReDim arrCity(n, m)

    n = n + 1
    m = m + 1
    ReDim Preserve arrCity(n, m)

每当我按照我写的那样做时，我都会收到以下错误：

运行时错误9：下标超出范围

因为我只能更改最后一个数组维度，所以在我的任务中我必须更改整个数组（在我的示例中为 2 个维度）！

是否有任何解决方法或其他解决方案？

【问题讨论】：

标签： arrays multidimensional-array vb6 dynamic-arrays

【解决方案1】：

正如您正确指出的那样，ReDim Preserve 只能是数组的最后一维（MSDN 上的ReDim Statement）：

如果使用 Preserve 关键字，则只能调整最后一个数组的大小维度，您根本无法更改维度的数量。为了例如，如果您的数组只有一维，您可以调整它的大小维度，因为它是最后也是唯一的维度。但是，如果您的数组有两个或多个维度，您只能更改最后一维，仍然保留数组的内容

因此，要决定的第一个问题是二维数组是否是该工作的最佳数据结构。也许，一维数组更适合你需要做ReDim Preserve？

另一种方法是按照Pieter Geerkens's suggestion 使用锯齿状数组。 VB6 中没有对锯齿状数组的直接支持。在 VB6 中编写“数组数组”的一种方法是声明一个 Variant 数组，并使每个元素成为所需类型的数组（在您的情况下为 String）。演示代码如下。

另一种选择是自行实现Preserve 部分。为此，您需要创建要保留的数据副本，然后用它填充重新调整的数组。

Option Explicit

Public Sub TestMatrixResize()
    Const MAX_D1 As Long = 2
    Const MAX_D2 As Long = 3

    Dim arr() As Variant
    InitMatrix arr, MAX_D1, MAX_D2
    PrintMatrix "Original array:", arr

    ResizeMatrix arr, MAX_D1 + 1, MAX_D2 + 1
    PrintMatrix "Resized array:", arr
End Sub

Private Sub InitMatrix(a() As Variant, n As Long, m As Long)
    Dim i As Long, j As Long
    Dim StringArray() As String

    ReDim a(n)
    For i = 0 To n
        ReDim StringArray(m)
        For j = 0 To m
            StringArray(j) = i * (m + 1) + j
        Next j
        a(i) = StringArray
    Next i
End Sub

Private Sub PrintMatrix(heading As String, a() As Variant)
    Dim i As Long, j As Long
    Dim s As String

    Debug.Print heading
    For i = 0 To UBound(a)
        s = ""
        For j = 0 To UBound(a(i))
            s = s & a(i)(j) & "; "
        Next j
        Debug.Print s
    Next i
End Sub

Private Sub ResizeMatrix(a() As Variant, n As Long, m As Long)
    Dim i As Long
    Dim StringArray() As String

    ReDim Preserve a(n)
    For i = 0 To n - 1
        StringArray = a(i)
        ReDim Preserve StringArray(m)
        a(i) = StringArray
    Next i
    ReDim StringArray(m)
    a(n) = StringArray
End Sub

【讨论】：

恐怕ResizeMatrix函数中的“StringArray=a(i)”行会出现“类型不匹配”错误。如果 i 超出旧矩阵的范围，则 a(i) 的类型为 Variant/Empty。它可以传递给 String() 类型的东西吗？

【解决方案2】：

由于 VB6 与 VBA 非常相似，我想我可能有一个不需要这么多代码的解决方案来 ReDim 一个二维数组 - 如果您在 Excel 中工作，请使用 Transpose。

解决方案（Excel VBA）：

Dim n, m As Integer
n = 2
m = 1
Dim arrCity() As Variant
ReDim arrCity(1 To n, 1 To m)

m = m + 1
ReDim Preserve arrCity(1 To n, 1 To m)
arrCity = Application.Transpose(arrCity)
n = n + 1
ReDim Preserve arrCity(1 To m, 1 To n)
arrCity = Application.Transpose(arrCity)

与OP的问题有什么不同：arrCity数组的下限不是0，而是1。这是为了让Application.Transpose做它的工作。

请注意，Transpose 是 Excel Application 对象的一个方法（实际上是Application.WorksheetFunction.Transpose 的快捷方式）。在 VBA 中，使用 Transpose 时必须小心，因为它有两个明显的限制：如果数组有超过 65536 个元素，它将失败。如果任何元素的长度超过 256 个字符，它将失败。如果这些都不是问题，那么 Transpose 会很好地将数组的秩从 1D 转换为 2D，反之亦然。

不幸的是，在 VB6 中没有像“转置”这样的功能。

【讨论】：

没有。 Transpose 是 Excel 应用程序对象的一种方法（实际上是 Application.WorksheetFunction.Transpose 的快捷方式）。 VB6 中没有类似的东西。在 VBA 中，使用 Transpose 时必须小心，因为它有两个重大限制。如果数组有超过 65536 个元素，它将失败。在任何元素的长度超过 256 个字符时，它都会失败。如果这些都不是问题，那么 Transpose 将很好地将数组的等级从 1D 转换为 2D，反之亦然。
请问您是从哪里/如何得知 Application.Transpose 是 Application.WorksheetFunction.Transpose 的快捷方式？

【解决方案3】：

关于这个：

“在我的任务中，我必须更改整个数组（二维”

只需使用“锯齿状”数组（即值数组的数组）。然后，您可以根据需要更改尺寸。您可以拥有一维变体数组，并且变体可以包含数组。

也许需要做更多的工作，但是一个解决方案。

【讨论】：

【解决方案4】：

我没有测试过这些答案中的每一个，但您不需要使用复杂的函数来完成此操作。比这容易得多！我下面的代码可以在任何办公 VBA 应用程序（Word、Access、Excel、Outlook 等）中工作，而且非常简单。希望这会有所帮助：

''Dimension 2 Arrays
Dim InnerArray(1 To 3) As Variant ''The inner is for storing each column value of the current row
Dim OuterArray() As Variant ''The outer is for storing each row in
Dim i As Byte

    i = 1
    Do While i <= 5

        ''Enlarging our outer array to store a/another row
        ReDim Preserve OuterArray(1 To i)

        ''Loading the current row column data in
        InnerArray(1) = "My First Column in Row " & i
        InnerArray(2) = "My Second Column in Row " & i
        InnerArray(3) = "My Third Column in Row " & i

        ''Loading the entire row into our array
        OuterArray(i) = InnerArray

        i = i + 1
    Loop

    ''Example print out of the array to the Intermediate Window
    Debug.Print OuterArray(1)(1)
    Debug.Print OuterArray(1)(2)
    Debug.Print OuterArray(2)(1)
    Debug.Print OuterArray(2)(2)

【讨论】：

【解决方案5】：

我知道这有点旧，但我认为可能有一个更简单的解决方案，不需要额外的编码：

与其再次转置、重新调整和转置，如果我们谈论二维数组，为什么不只存储转置后的值。在这种情况下， redim preserve 实际上从一开始就增加了右（第二个）维度。或者换句话说，为了可视化它，如果只有列的 nr 可以通过 redim preserve 增加，为什么不存储在两行而不是两列中。

索引将不是 00-01、01-11、02-12、03-13、04-14、05-15 ... 0 25-1 25 等等，而不是 00-01、10-11、 20-21、30-31、40-41 等等。

只要只有一个维度需要重新调整-保留该方法仍然有效：只需将该维度放在最后。

由于在重新调整时只能保留第二个（或最后一个）维度，因此有人可能会争辩说这就是数组最初应该使用的方式。我在任何地方都没有看到这个解决方案，所以也许我忽略了一些东西？

（之前发布过关于二维的类似问题，此处为更多维度的扩展答案）

【讨论】：

【解决方案6】：

您可以使用包含字符串数组的用户定义类型，该数组将成为内部数组。然后你可以使用这个用户定义类型的数组作为你的外部数组。

看看下面的测试项目：

'1 form with:
'  command button: name=Command1
'  command button: name=Command2
Option Explicit

Private Type MyArray
  strInner() As String
End Type

Private mudtOuter() As MyArray

Private Sub Command1_Click()
  'change the dimensens of the outer array, and fill the extra elements with "1"
  Dim intOuter As Integer
  Dim intInner As Integer
  Dim intOldOuter As Integer
  intOldOuter = UBound(mudtOuter)
  ReDim Preserve mudtOuter(intOldOuter + 2) As MyArray
  For intOuter = intOldOuter + 1 To UBound(mudtOuter)
    ReDim mudtOuter(intOuter).strInner(intOuter) As String
    For intInner = 0 To UBound(mudtOuter(intOuter).strInner)
      mudtOuter(intOuter).strInner(intInner) = "1"
    Next intInner
  Next intOuter
End Sub

Private Sub Command2_Click()
  'change the dimensions of the middle inner array, and fill the extra elements with "2"
  Dim intOuter As Integer
  Dim intInner As Integer
  Dim intOldInner As Integer
  intOuter = UBound(mudtOuter) / 2
  intOldInner = UBound(mudtOuter(intOuter).strInner)
  ReDim Preserve mudtOuter(intOuter).strInner(intOldInner + 5) As String
  For intInner = intOldInner + 1 To UBound(mudtOuter(intOuter).strInner)
    mudtOuter(intOuter).strInner(intInner) = "2"
  Next intInner
End Sub

Private Sub Form_Click()
  'clear the form and print the outer,inner arrays
  Dim intOuter As Integer
  Dim intInner As Integer
  Cls
  For intOuter = 0 To UBound(mudtOuter)
    For intInner = 0 To UBound(mudtOuter(intOuter).strInner)
      Print CStr(intOuter) & "," & CStr(intInner) & " = " & mudtOuter(intOuter).strInner(intInner)
    Next intInner
    Print "" 'add an empty line between the outer array elements
  Next intOuter
End Sub

Private Sub Form_Load()
  'init the arrays
  Dim intOuter As Integer
  Dim intInner As Integer
  ReDim mudtOuter(5) As MyArray
  For intOuter = 0 To UBound(mudtOuter)
    ReDim mudtOuter(intOuter).strInner(intOuter) As String
    For intInner = 0 To UBound(mudtOuter(intOuter).strInner)
      mudtOuter(intOuter).strInner(intInner) = CStr((intOuter + 1) * (intInner + 1))
    Next intInner
  Next intOuter
  WindowState = vbMaximized
End Sub

运行项目，点击表格显示数组的内容。

点击Command1放大外部数组，再次点击表格显示结果。

点击Command2放大内部数组，再次点击表格显示结果。

但请注意：当您重新调整外部数组时，您还必须为外部数组的所有新元素重新调整内部数组

【讨论】：

【解决方案7】：

我自己在遇到这个路障时偶然发现了这个问题。我最终写了一段代码来快速处理这个ReDim Preserve 在一个新大小的数组（第一个或最后一个维度）上。也许它会帮助其他面临同样问题的人。

因此，对于用法，假设您的数组最初设置为MyArray(3,5)，并且您想使尺寸（首先也是！）更大，让我们说MyArray(10,20)。你应该习惯做这样的事情吧？

 ReDim Preserve MyArray(10,20) '<-- Returns Error

但不幸的是，这会返回错误，因为您尝试更改第一个维度的大小。因此，使用我的函数，您只需执行以下操作：

 MyArray = ReDimPreserve(MyArray,10,20)

现在数组变大了，数据被保留了。您的多维数组的ReDim Preserve 已完成。 :)

最后但同样重要的是，神奇的功能：ReDimPreserve()

'redim preserve both dimensions for a multidimension array *ONLY
Public Function ReDimPreserve(aArrayToPreserve,nNewFirstUBound,nNewLastUBound)
    ReDimPreserve = False
    'check if its in array first
    If IsArray(aArrayToPreserve) Then       
        'create new array
        ReDim aPreservedArray(nNewFirstUBound,nNewLastUBound)
        'get old lBound/uBound
        nOldFirstUBound = uBound(aArrayToPreserve,1)
        nOldLastUBound = uBound(aArrayToPreserve,2)         
        'loop through first
        For nFirst = lBound(aArrayToPreserve,1) to nNewFirstUBound
            For nLast = lBound(aArrayToPreserve,2) to nNewLastUBound
                'if its in range, then append to new array the same way
                If nOldFirstUBound >= nFirst And nOldLastUBound >= nLast Then
                    aPreservedArray(nFirst,nLast) = aArrayToPreserve(nFirst,nLast)
                End If
            Next
        Next            
        'return the array redimmed
        If IsArray(aPreservedArray) Then ReDimPreserve = aPreservedArray
    End If
End Function

我在 20 分钟内写完这篇文章，因此无法保证。但是，如果您想使用或扩展它，请随意。我原以为有人已经在这里有了这样的代码，显然不是。所以，你们去吧，齿轮头们。

【讨论】：

【解决方案8】：

这更紧凑，并尊重数组中的初始第一个位置，只需使用初始绑定来添加旧值。

Public Sub ReDimPreserve(ByRef arr, ByVal size1 As Long, ByVal size2 As Long)
Dim arr2 As Variant
Dim x As Long, y As Long

'Check if it's an array first
If Not IsArray(arr) Then Exit Sub

'create new array with initial start
ReDim arr2(LBound(arr, 1) To size1, LBound(arr, 2) To size2)

'loop through first
For x = LBound(arr, 1) To UBound(arr, 1)
    For y = LBound(arr, 2) To UBound(arr, 2)
        'if its in range, then append to new array the same way
        arr2(x, y) = arr(x, y)
    Next
Next
'return byref
arr = arr2
End Sub

我用这条线调用这个 sub 来调整第一个维度的大小

ReDimPreserve arr2, UBound(arr2, 1) + 1, UBound(arr2, 2)

您可以添加其他测试来验证初始大小是否不大于新数组。在我的情况下，没有必要

【讨论】：

【解决方案9】：

在 VBA 中执行此操作的最简单方法是创建一个接收数组、新行数和新列数的函数。

在调整大小后，运行以下函数将所有旧数据复制回数组。

 function dynamic_preserve(array1, num_rows, num_cols)

        dim array2 as variant

        array2 = array1

        reDim array1(1 to num_rows, 1 to num_cols)

        for i = lbound(array2, 1) to ubound(array2, 2)

               for j = lbound(array2,2) to ubound(array2,2)

                      array1(i,j) = array2(i,j)

               next j

        next i

        dynamic_preserve = array1

end function

【讨论】：

【解决方案10】：

Function Redim2d(ByRef Mtx As Variant, ByVal QtyColumnToAdd As Integer)
    ReDim Preserve Mtx(LBound(Mtx, 1) To UBound(Mtx, 1), LBound(Mtx, 2) To UBound(Mtx, 2) + QtyColumnToAdd)
End Function

'Main Code
sub Main ()
    Call Redim2d(MtxR8Strat, 1)  'Add one column
end sub

'OR
sub main2()
    QtyColumnToAdd = 1 'Add one column
    ReDim Preserve Mtx(LBound(Mtx, 1) To UBound(Mtx, 1), LBound(Mtx, 2) To UBound(Mtx, 2) + QtyColumnToAdd)
end sub

【讨论】：

【解决方案11】：

如果您不想包含“ReDimPreserve”等其他功能，可以使用时间矩阵来调整大小。根据您的代码：

 Dim n As Integer, m As Integer, i as Long, j as Long
 Dim arrTemporal() as Variant

    n = 1
    m = 0
    Dim arrCity() As String
    ReDim arrCity(n, m)

    n = n + 1
    m = m + 1

    'VBA automatically adapts the size of the receiving matrix.
    arrTemporal = arrCity
    ReDim arrCity(n, m)

    'Loop for assign values to arrCity
    For i = 1 To UBound(arrTemporal , 1)
        For j = 1 To UBound(arrTemporal , 2)
            arrCity(i, j) = arrTemporal (i, j)
        Next
    Next

如果您不声明 VBA 类型，则假定它是 Variant。

将 n 作为整数，将 m 作为整数

【讨论】：