arrays - 在 Visual Basic 6 中 ReDim 保留到多维数组

Question

我正在使用 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 个维度）！

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

score 9 · Accepted Answer

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

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

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

另一种方法是按照Pieter Geerkens 的建议使用锯齿状数组。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

score 5 · Accepted Answer

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

解决方案（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是 ExcelApplication对象的一种方法（实际上是的快捷方式Application.WorksheetFunction.Transpose）。而在 VBA 中，使用时必须小心，Transpose因为它有两个明显的限制：如果数组有超过 65536 个元素，它将失败。如果任何元素的长度超过 256 个字符，它将失败。如果这些都不是问题，那么 Transpose 将很好地将数组的等级从 1D 转换为 2D，反之亦然。

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

score 3 · Accepted Answer

对此：

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

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

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

score 2 · Accepted Answer

我没有测试过这些答案中的每一个，但你不需要使用复杂的函数来完成这个。比这容易得多！我下面的代码可以在任何办公 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)

score 1 · Accepted Answer

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

而不是再次转置，重新调整和转置，如果我们谈论二维数组，为什么不只存储转置的值开始。在这种情况下， 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 等等。

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

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

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

score 0 · Accepted Answer

我自己碰到这个路障时偶然发现了这个问题。我最终写了一段代码来快速处理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 分钟内写了这篇文章，所以不能保证。但是，如果您想使用或扩展它，请随意。我原以为有人已经在这里有了这样的代码，显然不是。所以在这里你去齿轮头。

score 0 · Accepted Answer

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

看看下面的测试项目：

'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 以放大内部数组，然后再次单击窗体以显示结果。

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

score 0 · Accepted Answer

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

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

我用这条线调用这个子来调整第一个维度

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

您可以添加其他测试来验证初始大小是否不大于新数组。就我而言，没有必要

score 0 · Accepted Answer

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

score 0 · Accepted Answer

如果您不想包含其他功能，例如“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。

暗淡为整数,m为整数

score 0 · Accepted Answer

在 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

arrays - 在 Visual Basic 6 中 ReDim 保留到多维数组

11 回答 11

Related

Reference