问题
I wrote a VBA function that calls the SUMIFS worksheet function. It works perfectly but I would like to get rid of the Select statement. That requires that the Criteria range and Criteria argument pairs, nominally unlimited in number, be passed to SUMIFS as one array which is assembled in the function.
Here is my current code.
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
Note that the operator is passed to this function as a number (enum) between 0 and 5 which specifies one of the elements of Symb().
As you see, there are 4 different function calls in this procedure and if the function were to be called with 5 criteria pairs it would fail. Meanwhile, the differences between the 4 calls are minute and systematic, and a fifth one could be added in a minute.
I'm looking for a way to pass an assembled array of arguments to a single call of the worksheet function. I know this is possible by creating the corresponding worksheet function string and using the Evaluate function but when I write worksheet functions in VBA they turn out messy, meaning they are difficult to maintain and evolve. I like the clear structure of my above code and wouldn't like to sacrifice it for a little more efficiency, meaning I am open to arguments of much greater efficiency or pleasing design, whichever might be on offer.
EDIT 20 Jan 2021
I thought I had a solution with @GSerg's idea but the function call only accepts 2 sets of criteria. It doesn't seem to make sense because the third criterium is created in just the same way as the second. I'm wondering if I've become blind to a simple flaw. Please take a look.
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
If you run the code as it is it will work once the test ranges have been set up in the ActiveSheet, but not with the second worksheet function call.
回答1:
argument pairs, nominally unlimited in number
Actually, you can pass up to 14 pairs of ranges to SumIfs, as there are only 29 arguments. These Excel functions are normally limited to 30 arguments, adding the 15th pair would push the argument count to 31. So you can hardcode a Select Case for the 14 cases and call it day, it won't grow.
Another option is to manually pass the Missing value for the missing arguments:
Public Function GetMissingValue(Optional ByVal IgnoreMe As Variant) As Variant
If IsMissing(IgnoreMe) Then
GetMissingValue = IgnoreMe
Else
Err.Raise 5, , "I told you to ignore me, didn't I"
End If
End Function
Dim missing As Variant
missing = GetMissingValue()
...
Dim Args(0 To 13, 0 To 1) As Variant
Dim i As Long
For i = LBound(Ifs) To UBound(Ifs)
Set Args(i, 0) = Ifs(i)(0)
Args(i, 1) = Ifs(i)(1)
Next
For i = UBound(Ifs) + 1 To UBound(Args)
Args(i, 0) = missing
Args(i, 1) = missing
Next
SUMIFS = Application.WorksheetFunction.SUMIFS(SumRng, Args(0, 0), Args(0, 1), _
Args(1, 0), Args(1, 1), _
Args(2, 0), Args(2, 1), _
Args(3, 0), Args(3, 1), _
Args(4, 0), Args(4, 1), _
Args(5, 0), Args(5, 1), _
Args(6, 0), Args(6, 1), _
Args(7, 0), Args(7, 1), _
Args(8, 0), Args(8, 1), _
Args(9, 0), Args(9, 1), _
Args(10, 0), Args(10, 1), _
Args(11, 0), Args(11, 1), _
Args(12, 0), Args(12, 1), _
Args(13, 0), Args(13, 1))
回答2:
The function below can be called with a one to a maximum of 7 pairs of Criteria Range and Criterium. This limit can be extended to 13, requiring only a single change in the code at Redim Fun(7, 1) and addition of the extra arguments in the function call.
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(7, 1) ' extend to a maximum of 13 if required
Symb = Split(Symbols, ",")
For i = 0 To UBound(Fun)
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) = CLng(Ifs(i)(2))
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
SUMIFS = WorksheetFunction.SUMIFS(SumRng, Fun(0, 0), Fun(0, 1), _
Fun(1, 0), Fun(1, 1), _
Fun(2, 0), Fun(2, 1), _
Fun(3, 0), Fun(3, 1), _
Fun(4, 0), Fun(4, 1), _
Fun(5, 0), Fun(5, 1), _
Fun(6, 0), Fun(6, 1), _
Fun(7, 0), Fun(7, 1)) ', _
' Fun(8, 0), Fun(8, 1), _
' Fun(9, 0), Fun(9, 1), _
' Fun(10, 0), Fun(10, 1), _
' Fun(11, 0), Fun(11, 1), _
' Fun(12, 0), Fun(12, 1), _
' Fun(13, 0), Fun(13, 1))
End Function
In fact, the function call may be expanded to a number of arguments greater than Ubound(Fun) but not greater than 13, somewhat validating @GSerg's assertion that the total number (including the sum range) must be below 30.
I reformulated GSerg's supporting function that converts a non-existent argument to a "missing" one to match my method of understanding. It's functionality couldn't be improved but I prefer to keep it private since it's the slave of this one function.
Private Function SetMissing(Optional ByVal MissingValue As Variant) As Variant
' assign an uninitialized variant to "MissingValue"
If IsMissing(MissingValue) Then
SetMissing = MissingValue
Else
Err.Raise 5, , "Wrong use of function: The parameter must be missing!"
End If
End Function
Below is the procedure for testing my function, calling it with 1, 2 and 3 criteria. Note that the 0 argument specifies the first of the operators in Const Symbols. It therefore couldn't be a number greater than 5.
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
The code works with the worksheet pictured below.
来源：https://stackoverflow.com/questions/65759239/pass-arguments-to-a-worksheet-function-as-an-array-in-vba