使用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被保留，一個也許可以認爲這是數組應該如何使用開始。 我還沒有在任何地方看到過這個解決方案，所以我可能忽略了一些東西？

（早前關於兩個維度類似的問題發佈，在這裏擴展答案更多維度）