使用ReDim保留的多维数组在Visual Basic 6(ReDim Preserve to a

我使用VB6，我需要做一个使用ReDim保留到多维数组：

 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唯一一个数组（的最后一维ReDim语句上MSDN）：

如果使用保留关键字，你只能调整数组最后维，你可以不会改变维数。 例如，如果你的数组只有一个尺寸，你可以调整该维度，因为这是最后一次也是唯一尺度。 但是，如果你的阵列有两个或更多维度，则只能更改最后一维的大小，并且仍然保留数组的内容

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

另一种方法是使用锯齿状阵列按照彼得Geerkens的建议 。 有在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一个2维数组-使用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做的工作。

我想你应该有Transpose在VB6方法。

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:

我知道这是一个有点老，但我觉得可能是一个更简单的解决方案，无需额外的编码：

相反换位，redimming和调换再次，如果我们谈论一个二维数组，为什么不只是存储换位开始与价值观。 在这种情况下REDIM保留实际上增加了从一开始的权利（第二）尺寸。 或者换句话说，想象它，为什么不能在两行，而不是两列存储如果只列NR可以用REDIM保持增加。

指标将比是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等等。

只要有只有一个需要被redimmed保存完好的方法将仍起作用尺寸：只是把这个维度最后。

由于只有第二（或最后）的尺寸可以在redimming被保留，一个也许可以认为，这是多么阵列都应该被用来开始。 我还没有看到这一解决方案的任何地方，所以也许我俯瞰的东西吗？

（早前关于两个维度类似的问题，发布，扩展答案这里查看更多维）

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

运行该项目，并单击窗体上显示数组的内容。

单击Command放大外阵列，然后再次单击窗体上显示的结果。

单击Command放大内部数组，然后再次单击窗体上显示的结果。

不过要小心：当你REDIM外阵列，你还必须REDIM内阵列来外阵列的所有新元素

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:

这是更紧凑，尊重阵列INTIAL第一位置和只是使用绑定到添加旧值inital。

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)

您可以添加其他测试来验证，如果初始大小不超过新阵列上。 在我的情况下，没有必要

文章来源: ReDim Preserve to a Multi-Dimensional Array in Visual Basic 6