Question

我想使用Sub读取Excel工作簿（从cell(3, 1)开始）中一列的值，然后将数组传递给main函数，但是在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

如何使用Sub填充（动态）数组的值

2 个答案: