ReDim保留在Visual Basic 6中的多维数组

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维）！

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

Answer 1

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

  

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

因此，要确定的第一个问题是二维数组是否是作业的最佳数据结构。也许，1维数组更适合您需要ReDim Preserve？

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

另一种选择是自己实施Preserve部分。为此，您需要创建要保留的数据副本，然后用它填充redimensioned数组。

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

Answer 2

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

解决方案（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完成它的工作。

我认为你应该在VB6中使用Transpose方法。

Answer 3

关于这一点：

  

“在我的任务中我必须改变整个阵列（2维”

只使用锯齿状数组（即数组值数组）。然后，您可以根据需要更改尺寸。或许可以做更多的工作，但这是一个解决方案。

Answer 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)

Answer 5

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

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

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

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

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

（之前发表过关于两个维度的类似问题，这里有更多维度的扩展答案）

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

小心但是：当你重新编写外部数组时，你还需要为外部数组的所有新元素重新构建内部数组

Answer 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分钟内写了这个，所以没有保证。但如果您想使用或扩展它，请随意。我会认为有人会在这里有一些像这样的代码，显然不是。所以，你可以去找其他的减速机。

Answer 8

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

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)

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

Answer 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

Answer 10

int toRemove = 0; //The number to remove from your list
List<Integer> list = /* your list */;
list.removeIf(val -> toRemove == val); //didn't use member reference, for clarity reasons

Answer 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。

Dim n 作为整数, m 作为整数