【发布时间】：2023-03-05 07:50:01
【问题描述】：
我编写了一个调用 SUMIFS 工作表函数的 VBA 函数。它工作得很好，但我想摆脱 Select 语句。这要求 Criteria range 和 Criteria 参数对（名义上数量不受限制）作为一个数组传递给 SUMIFS，并在函数中组装。
这是我当前的代码。
Function SUMIFS(SumRng As Range, _
ParamArray Ifs() As Variant) As Double
' each element of Ifs is an array of 3 elements:
' 0 = Criteria range, 1 = Operator, 2 = Criterium
Const Symbols As String = "=,<>,>,<,<=,>="
Dim Symb() As String
Dim Tmp As Variant
Dim i As Long ' Ifs index
Symb = Split(Symbols, ",")
For i = LBound(Ifs) To UBound(Ifs)
Tmp = Ifs(i)(1)
If VarType(Ifs(i)(2)) = vbDate Then
Ifs(i)(1) = Format(Ifs(i)(2), Ifs(i)(0).Cells(1).NumberFormat)
Else
Ifs(i)(1) = Ifs(i)(2)
End If
If Val(Tmp) Then Ifs(i)(1) = Symb(Tmp) & Ifs(i)(1)
Next i
Select Case UBound(Ifs)
Case 0
SUMIFS = WorksheetFunction.SUMIFS(SumRng, Ifs(0)(0), Ifs(0)(1))
Case 1
SUMIFS = WorksheetFunction.SUMIFS(SumRng, Ifs(0)(0), Ifs(0)(1), _
Ifs(1)(0), Ifs(1)(1))
Case 2
SUMIFS = WorksheetFunction.SUMIFS(SumRng, Ifs(0)(0), Ifs(0)(1), _
Ifs(1)(0), Ifs(1)(1), _
Ifs(2)(0), Ifs(2)(1))
Case 3
SUMIFS = WorksheetFunction.SUMIFS(SumRng, Ifs(0)(0), Ifs(0)(1), _
Ifs(1)(0), Ifs(1)(1), _
Ifs(2)(0), Ifs(2)(1), _
Ifs(3)(0), Ifs(3)(1))
Case 4
SUMIFS = WorksheetFunction.SUMIFS(SumRng, Ifs(0)(0), Ifs(0)(1), _
Ifs(1)(0), Ifs(1)(1), _
Ifs(2)(0), Ifs(2)(1), _
Ifs(3)(0), Ifs(3)(1), _
Ifs(4)(0), Ifs(4)(1))
End Select
End Function
请注意，运算符作为 0 到 5 之间的数字（枚举）传递给此函数，它指定 Symb() 的元素之一。
如您所见，此过程中有 4 个不同的函数调用，如果使用 5 个标准对调用该函数，它将失败。同时，这4个调用之间的差异是微小而系统的，一分钟内可以添加第五个。
我正在寻找一种将组装的参数数组传递给工作表函数的单个调用的方法。我知道这可以通过创建相应的工作表函数字符串并使用Evaluate 函数来实现，但是当我在 VBA 中编写工作表函数时，它们变得混乱，这意味着它们难以维护和发展。我喜欢上面代码的清晰结构，并且不想为了提高一点效率而牺牲它，这意味着我愿意接受更高效率或令人愉悦的设计的论点，无论哪一种都可以提供。
2021 年 1 月 20 日编辑
我以为我有一个 @GSerg 想法的解决方案，但函数调用只接受 2 组标准。这似乎没有意义，因为第三个标准的创建方式与第二个标准相同。我想知道我是否对一个简单的缺陷视而不见。请看一下。
Private Sub Test_SUMIFS()
Dim SumRng As Range
Set SumRng = Range("A2:A11")
Debug.Print SUMIFS(SumRng, Array(Range("B2:B11"), 0, "A"))
Debug.Print SUMIFS(SumRng, Array(Range("B2:B11"), 0, "A"), _
Array(Range("C2:C11"), 0, 10))
' Debug.Print SUMIFS(SumRng, Array(Range("B2:B11"), 0, "A"), _
' Array(Range("C2:C11"), 0, 10), _
' Array(Range("D2:D11"), 0, "Z"))
End Sub
Function SUMIFS(SumRng As Range, _
ParamArray Ifs() As Variant) As Double
' each element of Ifs is an array of 3 elements:
' 0 = Criteria range, 1 = Operator, 2 = Criterium
Const Symbols As String = "=,<>,>,<,<=,>="
Dim Symb() As String
Dim Fun() As Variant ' Converterd Ifs()
Dim Tmp As Variant
Dim i As Long ' Ifs index
ReDim Fun(2, 1) ' extend to a maximum of 14 if required
Symb = Split(Symbols, ",")
For i = LBound(Ifs) To 1
If i > UBound(Ifs) Then
Fun(i, 0) = SetMissing()
Fun(i, 1) = SetMissing()
Else
Set Fun(i, 0) = Ifs(i)(0)
Fun(i, 1) = Ifs(i)(2)
Tmp = Ifs(i)(1)
If VarType(Ifs(i)(2)) = vbDate Then
Fun(i)(1) = Format(Ifs(i)(2), Ifs(i)(0).Cells(1).NumberFormat)
Else
Fun(i, 1) = Ifs(i)(2)
End If
If Val(Tmp) Then Fun(i)(1) = Symb(Tmp) & Fun(i)(1)
End If
Next i
' this function call works for both calls
SUMIFS = WorksheetFunction.SUMIFS(SumRng, Fun(0, 0), Fun(0, 1), _
Fun(1, 0), Fun(1, 1))
' this function call doesn't work
' SUMIFS = WorksheetFunction.SUMIFS(SumRng, Fun(0, 0), Fun(0, 1), _
' Fun(1, 0), Fun(1, 1), _
' Fun(2, 0), Fun(2, 1))
End Function
Private Function SetMissing(Optional ByVal MissingValue As Variant) As Variant
' assign the value of "Missing" to an uninitialized variant
If IsMissing(MissingValue) Then
SetMissing = MissingValue
Else
Err.Raise 5, , "Wrong use of function: The parameter must be missing!"
End If
End Function
如果您按原样运行代码，一旦在 ActiveSheet 中设置了测试范围，它就可以工作，但不能使用第二个工作表函数调用。
【问题讨论】：
-
请问这个函数怎么调用？ 'ParamArray()' 中有哪些元素？如果在锯齿状阵列上闻起来，但你如何构建它？使用精确的
SumIfs参数，也用逗号分隔？ -
@FaneDuru 从使用上看，一定是
SUMIFS(Me.Range("A1:A10"), Array(Me.Range("B1:B10"), 2), Array(Me.Range("C1:C10"), 3))。但是，调用此函数的确切方式对于回答如何将其传递给SumIfs的问题并不重要。 -
@FaneDuru 感谢您的回复。我有 2 天没有上网。所以，很抱歉回复晚了，但我不能补充 GSerg 已经说过的话:-)
-
没问题。如果我会更专注地阅读这个问题，我不应该问这个问题......我最初理解传递变量的方式不起作用，并试图理解这是否是错误参数的问题。否则，参数只能采用 GSerg 建议的方式。