Ошибка VBA с Redim Preserve и Application.Transpose изменяющейся базы массива - PullRequest
0 голосов
/ 20 марта 2019

У меня есть двумерный массив. Я хотел создать redim preserv в первом измерении, но я знаю, что redim preseve работает только в последнем измерении. Я пытался использовать функцию транспонирования, но кажется, что транспонирование меняет мой массив с базы 0 на базу 1, это нормально? если да, как установить его обратно на базу 0? или как решить мою проблему, чтобы сохранить мой массив при изменении его первого измерения? Я хочу добавить 2 элемента в мой массив

вот часть моего кода, где я получаю проблему:

    table3 = Application.Transpose(table3)
    ReDim Preserve table3(Ubound(table3,1), Ubound(table3,2) +2)
    table3 = Application.Transpose(table3)

Я заметил, что до транспонирования массив равен base 0, а после транспонирования - base 1, и я думаю, что это основная проблема. Я не хочу менять основание с 0 на 1, потому что я использую тот же массив в другом месте моего кода, и я не хочу менять весь код.

Следующая строка кода выдаст мне ошибку

«Индекс вне диапазона»

ReDim Preserve table3(Ubound(table3,1), Ubound(table3,2) +2) 

если я изменю его на следующую строку

ReDim Preserve table3(1 To UBound(table3, 1), UBound(table3, 2) + 2)

это будет работать, но мой массив станет массивом на основе 1, что не то, что я хочу, я хочу, чтобы мои индексы начинались с 0, а не с 1

ПЕРЕД ТРАНСПОРТИРОВКОЙ

BEFORE TRANSPOSE

ПОСЛЕ ТРАНСПОЗИЦИИ

enter image description here

1 Ответ

1 голос
/ 21 марта 2019

Возможно, это поможет вам:

'********************************************************************************************************************
' To re-dimension the first dimension of a two-dimension array without getting Excel errors
' Also possible to re-dimension the second dimension
' Usage: myArray = reDimPreserve(myArray, UBound(myArray, 1) + x, UBound(myArray, 2) + y)
' Where x and y are the increments to get to the desired new dimensions
' Returns an empty array if there was an error
'********************************************************************************************************************
Public Function reDimPreserve(ByVal aArray As Variant, ByVal newFirstUBound As Long, ByVal newLastUBound As Long) As Variant
Dim tmpArr As Variant, nOldFirstUBound As Long, nOldLastUBound As Long, nFirst As Long, nLast As Long

If Not IsArray(aArray) Then
    reDimPreserve = Array()
ElseIf newFirstUBound < UBound(aArray, 1) Or newLastUBound < UBound(aArray, 2) Then
    reDimPreserve = Array()
Else
    ReDim tmpArr(newFirstUBound, newLastUBound)
    nOldFirstUBound = UBound(aArray, 1)
    nOldLastUBound = UBound(aArray, 2)
    For nFirst = LBound(aArray, 1) To newFirstUBound
        For nLast = LBound(aArray, 2) To newLastUBound
            If nOldFirstUBound >= nFirst And nOldLastUBound >= nLast Then
                tmpArr(nFirst, nLast) = aArray(nFirst, nLast)
            End If
        Next nLast
    Next nFirst
    reDimPreserve = tmpArr
    Erase tmpArr
End If

End Function
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...