Excel VBA - Как переделать 2D-массив?

Ответ 1

Это не совсем интуитивно понятно, но вы не можете переделать (VB6 Ref) массив, если вы затушевали его с размерами. Точная цитата из связанной страницы:

Оператор ReDim используется для изменения размера или изменения размера динамического массива, который имеет уже было официально объявлено с использованием Private, Public или Dim с пустыми скобками (без индексных индексов).

Другими словами, вместо dim invoices(10,0)

Вы должны использовать

Dim invoices()
Redim invoices(10,0)

Затем, когда вы ReDim, вам нужно будет использовать Redim Preserve (10,row)

Предупреждение. При перенастройке многомерных массивов, если вы хотите сохранить свои значения, вы можете увеличить только последнее измерение. И.Е. Redim Preserve (11,row) или даже (11,0) завершится с ошибкой.

Ответ 2

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

Ответ 3

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

Вместо того, чтобы переносить, перерисовывать и переносить снова, и если мы говорим о двухмерном массиве, почему бы просто не сохранить значения, перенесенные для начала. В этом случае 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 и т.д.

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

Ответ 4

здесь обновлен код метода redim preseve с объявлением variabel, надеюсь, что @Control Freak в порядке с ним:)

Option explicit
'redim preserve both dimensions for a multidimension array *ONLY
Public Function ReDimPreserve(aArrayToPreserve As Variant, nNewFirstUBound As Variant, nNewLastUBound As Variant) As Variant
    Dim nFirst As Long
    Dim nLast As Long
    Dim nOldFirstUBound As Long
    Dim nOldLastUBound As Long

    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

Ответ 5

Вот как я это делаю.

Dim TAV() As Variant
Dim ArrayToPreserve() as Variant

TAV = ArrayToPreserve
ReDim ArrayToPreserve(nDim1, nDim2)
For i = 0 To UBound(TAV, 1)
    For j = 0 To UBound(TAV, 2)
        ArrayToPreserve(i, j) = TAV(i, j)
    Next j
Next i

Ответ 6

Небольшое обновление того, что @control freak и @skatun писали ранее (извините, у меня недостаточно репутации, чтобы просто комментировать). Я использовал код skatun, и он работал хорошо для меня, за исключением того, что он создавал массив большего размера, чем мне было нужно. Поэтому я изменил:

ReDim aPreservedArray(nNewFirstUBound, nNewLastUBound)

чтобы:

ReDim aPreservedArray(LBound(aArrayToPreserve, 1) To nNewFirstUBound, LBound(aArrayToPreserve, 2) To nNewLastUBound)

Это сохранит все нижние границы исходного массива (либо 0, 1, либо что угодно; исходный код предполагает 0) для обоих измерений.

Ответ 7

я решил это более коротким способом.

Dim marray() as variant, array2() as variant, YY ,ZZ as integer
YY=1
ZZ=1

Redim marray(1 to 1000, 1 to 10)
Do while ZZ<100 ' this is populating the first array
marray(ZZ,YY)= "something"
ZZ=ZZ+1
YY=YY+1 
Loop
'this part is where you store your array in another then resize and restore to original
array2= marray
Redim marray(1 to ZZ-1, 1 to YY)
marray = array2

Ответ 8

Вот и ты.

Открытая функция ReDimPreserve (ByRef Arr, ByVal idx1 как целое число, ByVal idx2 как целое число)

Dim newArr()
Dim x As Integer
Dim y As Integer

ReDim newArr(idx1, idx2)

For x = 0 To UBound(Arr, 1)
    For y = 0 To UBound(Arr, 2)
        newArr(x, y) = Arr(x, y)
    Next
Next

Arr = newArr

End Function