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

我有一个简单的Excel UDF的质量值转换为摩尔分数。 大多数时候，输出将是一个列数组（n行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 

我明白，如果没有别的，我可以有一个input参数标志如果返回应该是一个行数组。 我希望不要走这条路。

Answer 1

这是UDF()一个小例子：

1. 接受可变数量的input范围
2. 提取这些范围内的唯一值
3. 创build一个合适的输出数组（列，行或块）
4. 将独特的价值转移到该地区

 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 

Answer 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)