Как использовать Sub для заполнения значений (динамического) массива

Question

Я хочу прочитать значения столбца в книге Excel (начиная с cell(3, 1)), используя Sub, который затем доставит массив в основную функцию, но значения, полученные внутри sub, не возвращаются в массив в основной функции.

В настоящее время у меня есть значения в Cells(3, 1) и (4, 1), и я знаю, что Sub работает, потому что я помещаю в окно сообщения внутри Sub, и он читает оба значения.

Я попытался превратить Sub в функцию, изменив имя параметра Sub на то же имя, что и у массива в основной функции (tr_des), и много подобных вещей.

Option Explicit
Private Sub cmd_openform_Click() '"Main" function
    Dim tr_des() As String
        Call getDescriptions(tr_des)
    uf_TestSelector.Show vbModal    'shows properly
    MsgBox tr_des(1)    'shows empty MsgBox
End Sub

Sub getDescriptions(ByRef des_array() As String)
    Dim descrip As String, size As Integer
    Dim i As Integer
    i = 0
    size = 1
    ReDim des_array(size)
    Do While Cells(i + 3, 1).Value <> ""
        des_array(i) = Cells(i + 3, 1).Value
        MsgBox des_array(i) 'opens MsgBox with correct value both times
        size = size + 1
        ReDim des_array(size)
        i = i + 1
    Loop
End Sub

Я ожидал, что MsgBox tr_des(1) вернет значение из столбца из таблицы Excel, но оно всегда возвращает пустой MsgBox

Answer 1

Вам нужно использовать ReDim Preserve.

Если вы сделаете MsgBox des_array(i) после вашего ReDim, вы увидите, что значения пропали :)

ReDim(без Preserve) перераспределяет массив для указанных размеров.Использование ReDim Preserve - это то, как вы увеличиваете размер массива, не стирая его содержимое.

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

Answer 2

@ DavidZemens представил ReDim Preserve как один из подходов к решению вашей проблемы. Я рекомендую другой подход к программированию, позволяющий избежать дорогостоящего действия VBA Preserve (снижение производительности может быть заметно на больших массивах, но в вашем случае это не важно).

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

Option Explicit
Private Sub cmd_openform_Click() '"Main" function
Dim tr_des As Variant
    tr_des = getDescriptions
    uf_TestSelector.Show vbModal    'shows properly
    MsgBox tr_des(1)    
End Sub

Function getDescriptions() as Variant
Dim tValidRange as Range
Dim i As Integer
    Set tValidRange = Nothing ' Not really required but nice to be explicit
    i = 0
    Do While Cells(i + 3, 1).Value <> ""
        If tValidRange is Nothing Then
            Set tValidRange  = Cells(i + 3, 1)
        Else
            Set tValidRange  = Union(tValidRange,Cells(i + 3, 1))
            'Set tValidRange  = tValidRange.Resize(tValidRange.Rows.COunt + 1,1) ' Alternate approach
        End If
        i = i + 1
    Loop
    getDescriptions = tValidRange.Value ' Places values into an array.
End Sub

Конечно, новый способ мышления ведет к дальнейшему совершенствованию кода.

Function getDescriptions() as Variant
Dim tValidRange as Range
Dim tRangeToCheck as Range
Dim i As Integer
    Set tValidRange = Nothing ' Not really required but nice to be explicit
    Set tRangeToCheck = Cells(3,1) 'This really should be fully qualified but ...
        ' ... you have not provided enough information for an example.

    Do While tRangeToCheck.Value <> ""
        If tValidRange is Nothing Then
            Set tValidRange  = tRangeToCheck
        Else
            Set tValidRange  = tValidRange.Resize(tValidRange.Rows.Count + 1,1) ' expand range down by one row.
        End If
        Set tRangeToCheck = tRangeToCheck.Offset(1,0) ' move down one row
    Loop
    getDescriptions = tValidRange.Value ' Places values into an array.
End Sub