ReDim Сохраняет многомерный массив в Visual Basic 6

Ответ 1

Как вы правильно указываете, ReDim Preserve можно использовать только последнее измерение массива (ReDim Statement на MSDN):

Если вы используете ключевое слово Preserve, вы можете изменить размер только последнего массива и вы не можете изменить количество измерений вообще. Для Например, если ваш массив имеет только одно измерение, вы можете изменить его размер потому что это последнее и единственное измерение. Однако, если ваш массив имеет два или более измерений, вы можете изменить размер только Последнее измерение и сохранить содержимое массива

Следовательно, первый вопрос, который нужно решить, заключается в том, является ли двумерный массив лучшей структурой данных для задания. Возможно, 1-мерный массив лучше подходит, как вам нужно сделать ReDim Preserve?

Другим способом является использование jagged массива в соответствии с предложением 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

Ответ 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 выполняет эту работу.

Я думаю, что вы должны иметь метод Transpose в VB6.

Ответ 3

Относительно этого:

"в моей задаче я должен изменить весь массив (2 измерения"

Просто используйте зубчатый массив (т.е. массив массивов значений). Затем вы можете изменить размеры по своему желанию. Возможно, немного больше работы, но решение.

Ответ 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)

Ответ 5

Я знаю, что это немного устарело, но я думаю, что может быть гораздо более простое решение, которое не требует дополнительного кодирования:

Вместо того, чтобы переносить, перерисовывать и переносить снова, и если мы говорим о двухмерном массиве, почему бы просто не сохранить значения, перенесенные для начала. В этом случае redim preserve фактически увеличивает правое (второе) измерение с самого начала. Или, другими словами, чтобы визуализировать его, почему бы не сохранить в двух строках вместо двух столбцов, если только число столбцов можно увеличить с сохранением 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 и т.д.

Пока есть только одно измерение, которое нужно обновить - сохранившийся подход все равно будет работать: просто поместите это измерение последним.

Поскольку только второе (или последнее) измерение может быть сохранено при повторном воспроизведении, возможно, можно утверждать, что именно так предполагается использовать массивы. Я не видел этого решения нигде, поэтому, возможно, я что-то не замечаю?

(Добавлено ранее по аналогичному вопросу о двух измерениях, расширенный ответ здесь для большего размера)

Ответ 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, чтобы увеличить внутренний массив, и снова нажмите на форму, чтобы показать результаты.

Будьте осторожны: когда вы удаляете внешний массив, вам также нужно переделать внутренние массивы для всех новых элементов внешнего массива

Ответ 7

Я наткнулся на этот вопрос, когда сам ударил этот дорожный блок. В итоге я написал кусок кода, который бы быстро справился с этим ReDim Preserve в массиве нового размера (первое или последнее измерение). Возможно, это поможет другим, кто сталкивается с той же проблемой.

Итак, для использования предположим, что ваш массив изначально установлен как MyArray(3,5), и вы хотите увеличить размеры (сначала слишком!), просто скажите MyArray(10,20). Вы привыкли бы делать что-то вроде этого?

 ReDim Preserve MyArray(10,20) '<-- Returns Error

Но, к сожалению, это возвращает ошибку, потому что вы пытались изменить размер первого измерения. Таким образом, с моей функцией вы бы просто сделали что-то вроде этого:

 MyArray = ReDimPreserve(MyArray,10,20)

Теперь массив больше, и данные сохраняются. Ваш ReDim Preserve для массива Multi-Dimension завершен.:)

И последнее, но не менее важное: чудесная функция: 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 минут, поэтому никаких гарантий нет. Но если вы хотите использовать или расширять его, не стесняйтесь. Я бы подумал, что у кого-то уже был бы такой код здесь, но, видимо, нет. Итак, здесь идут разные редукторы.

Ответ 8

Это более компактно и уважает начальную первую позицию в массиве и просто использует встроенную привязку для добавления старого значения.

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

Я вызываю этот sub с этой строкой, чтобы изменить размер первого измерения

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

Вы можете добавить другой тест, чтобы проверить, не является ли начальный размер не верхним, чем новый массив. В моем случае это не обязательно

Ответ 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