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

Question

我使用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) 

每当我这样做，因为我已经写它，我得到以下错误：

runtime error 9: subscript out of range

因为我只能改变最后的数组维度，以及在我的任务，我不得不改变整个阵列（在我的例子2名维）！

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

Answer 1

在问候这样：

"in my task I have to change the whole array (2 dimensions"

只需使用交错数组（即值的数组的数组）。然后，您可以根据需要更改尺寸。也许更多的工作，但一个解决方案。

Answer 2

正如你正确指出的，人们可以ReDim Preserve只有一个数组（ReDim Statement上MSDN）的最后一个维度：

If you use the Preserve keyword, you can resize only the last array dimension and you can't change the number of dimensions at all. For example, if your array has only one dimension, you can resize that dimension because it is the last and only dimension. However, if your array has two or more dimensions, you can change the size of only the last dimension and still preserve the contents of the array

因此，决定第一个问题是2维数组是否是最佳的数据工作结构。也许，1维阵列更适合你需要做的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 

Answer 3

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

看一看下面的测试项目：

'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 4

我碰到这个问题，跌跌撞撞，同时击中这条道路封锁自己的所有新元素。我最后写一段代码，真正的快到一个新的大小的数组（第一个或最后一个维度）在处理这个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 5

这更加紧凑，尊重数组中的初始位置，只是使用初始值增加旧值。

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 6

由于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 7

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

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

相反变调，redimming并再次调换的，如果我们谈论一个二维数组，为什么不只是存储转换开始的值。在这种情况下，redim preserve实际上会从一开始就增加正确的（第二个）维度。或者换句话说，想象它，为什么不能在两行，而不是两列存储如果只列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被保留，一个也许可以认为这是数组应该如何使用开始。 我还没有在任何地方看到过这个解决方案，所以我可能忽略了一些东西？

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