Excel VBA - 确定数组 UDF 的列或行目标

Posted 2023-04-13

【中文标题】Excel VBA - 确定数组 UDF 的列或行目标

【英文标题】：Excel VBA - Determining Column or Row Target of Array UDF

【发布时间】：2017-12-08 14:27:25

【问题描述】：

我有一个简单的 Excel UDF，用于将质量值数组转换为摩尔分数。大多数情况下，输出将是一个列数组（n 行 x 1 列）。

如何在 VBA 环境中确定工作表上目标单元格的尺寸，以确保它应该以 n 行 1 列而不是 n 列 1 行的形式返回？

Function molPct(chemsAndMassPctsRng As Range)

Dim chemsRng As Range
Dim massPctsRng As Range
Dim molarMasses()
Dim molPcts()

Set chemsRng = chemsAndMassPctsRng.Columns(1)
Set massPctsRng = chemsAndMassPctsRng.Columns(2)

chems = oneDimArrayZeroBasedFromRange(chemsRng) 
massPcts = oneDimArrayZeroBasedFromRange(massPctsRng)

'oneDimArrayZeroBasedFromRange is a UDF to return a zero-based array from a range.

ReDim molarMasses(UBound(chems))
ReDim molPcts(UBound(chems))

totMolarMass = 0

For chemNo = LBound(chems) To UBound(chems)

    molarMasses(chemNo) = massPcts(chemNo) / mw(chems(chemNo))
    totMolarMass = totMolarMass + molarMasses(chemNo)

Next chemNo

For chemNo = LBound(chems) To UBound(chems)

    molPcts(chemNo) = Round(molarMasses(chemNo) / totMolarMass, 2)

Next chemNo

molPct = Application.WorksheetFunction.Transpose(molPcts)

End Function

我知道，如果没有别的，我可以有一个输入参数来标记是否返回应该是一个行数组。我希望不要走那条路。

【问题讨论】：

在 UDF 中 Application.ThisCell 为您提供包含公式的范围。很确定这也适用于数组公式。 Application.Caller 类似。您应该能够使用其中之一来确定您的输出数组的尺寸。 cpearson.com/excel/returningarraysfromvba.aspx

【参考方案1】：

这是UDF() 的一个小例子：

接受可变数量的输入范围 提取这些范围内的唯一值 创建合适的输出数组（列、行或块） 将唯一值转储到该区域

Public Function ExtractUniques(ParamArray Rng()) As Variant
    Dim i As Long, r As Range, c As Collection, OutPut
    Dim rr As Range, k As Long, j As Long

    Set c = New Collection
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '
    '   First grab all the data and make a Collection of uniques
    '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    On Error Resume Next
        For i = LBound(Rng) To UBound(Rng)
            Set r = Rng(i)
            For Each rr In r
                c.Add rr.Value, CStr(rr.Value)
            Next rr
        Next i
    On Error GoTo 0
   '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   '
   '    next create an output array the same size and shape
   '    as the worksheet output area
   '
   ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    k = 1
    With Application.Caller
        ReDim OutPut(1 To .Rows.Count, 1 To .Columns.Count)
    End With

    For i = LBound(OutPut, 1) To UBound(OutPut, 1)
        For j = LBound(OutPut, 2) To UBound(OutPut, 2)
            If k < c.Count + 1 Then
                OutPut(i, j) = c.Item(k)
                k = k + 1
            Else
                OutPut(i, j) = ""
            End If
        Next j
    Next i
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '
    '   put the data on the sheet
    '
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    ExtractUniques = OutPut
End Function

【讨论】：

谢谢！ Application.Caller 应该可以工作。另外，我需要了解更多关于集合的信息。它们似乎比数组灵活得多。

@MichaelJames 让数组和集合一起工作很容易.....

【参考方案2】：

您应该返回二维数组：行向量为 n × 1，列向量为 1 × n。

所以你需要一个

Redim molPcts(1, Ubound(chems) + 1)

或

Redim molPcts(Ubound(chems) + 1, 1)

要引用它们，您需要使用两个索引：

molPcts(1, chemNo + 1)

或

molPcts(chemNo + 1, 1)

如果你更喜欢从 0 开始的数组，redim 应该是这样的：

Redim molPcts(0 To 0, 0 To Ubound(chems))
Redim molPcts(0 To Ubound(chems), 0 To 0)

【讨论】：

谢谢。如果我使用二维数组，我如何在 VBA 中确定它们是否需要以 1 x n 或 n x 1 的形式表示？这是否取决于 excel 工作表上目标单元格的尺寸？如果是这样，有没有办法从 VBA 环境中检测目标单元格的尺寸？