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

【问题标题】：How to use a Sub to populate values of a (dynamic) array如何使用 Sub 填充（动态）数组的值
【发布时间】：2019-06-05 04:44:36
【问题描述】：

我想使用 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

【问题讨论】：

标签： excel vba

【解决方案1】：

您需要使用ReDim Preserve。

如果您在ReDim 之后执行MsgBox des_array(i) ，您会看到这些值消失了:)

ReDim（没有Preserve）将数组重新分配到指定的维度。使用ReDim Preserve 是增加数组大小而不清除其内容的方法。

如果使用Preserve 关键字，则只能调整最后一个数组维度的大小，根本无法更改维度数。例如，如果您的数组只有一个维度，您可以调整该维度的大小，因为它是最后一个也是唯一的维度。但是，如果您的数组有两个或多个维度，您可以只更改最后一个维度的大小，并且仍然保留数组的内容。

【讨论】：

【解决方案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

【讨论】：