加权平均 IFS UDF

Question

我正在尝试使加权平均 Ifs function 具有最多三个 ifs 的能力。 就目前而言，function 仅在删除可选性并且所有 arguments 均由用户填写时才有效。 当 function 运行时#Value。 optional arguments 未填写时返回。 这是有问题的完整代码。

Function WeightedAvgIfs(ByVal values As Range, ByVal weights As Range, _
ByVal ConditionRange1 As Range, ByVal Condition1 As String, _
Optional ByVal ConditionRange2 As Range = Nothing, Optional ByVal Condition2 As String = "=ZZZ", _
Optional ByVal ConditionRange3 As Range = Nothing, Optional ByVal Condition3 As String = "=ZZZ") As Double

Dim ValuesArray(), WeightsArray(), Condition1Array(), Condition2Array(), Condition3Array() As Variant
Dim i As Long
Dim dsum As Double
Dim StringOperator As String
Dim Condition As Variant

ValuesArray = Range(values.Address(1, 1, xlA1, 1))
WeightsArray = Range(weights.Address(1, 1, xlA1, 1))
Condition1Array = Range(ConditionRange1.Address(1, 1, xlA1, 1))
Condition2Array = Range(ConditionRange2.Address(1, 1, xlA1, 1))
Condition2Array = Range(ConditionRange3.Address(1, 1, xlA1, 1))

'Condition 1
For i = LBound(ValuesArray) To UBound(ValuesArray)

    Select Case Left(Condition1, 2)
        Case Is = "<="
            StringOperator = "<="
            Condition = Val(Mid(Condition1, 3, Len(Condition1)))
        Case Is = ">="
            StringOperator = ">="
            Condition = Val(Mid(Condition1, 3, Len(Condition1)))
        Case Is = "<>"
            StringOperator = "<>"
            If IsNumeric(Mid(Condition1, 3, Len(Condition1))) And Not IsEmpty(Condition1) Then
                Condition = Val(Mid(Condition1, 3, Len(Condition1)))
            Else
                Condition = UCase(Mid(Condition1, 3, Len(Condition1)))
            End If
        
        Case Else
            Select Case Left(Condition1, 1)
                Case Is = "<"
                    StringOperator = "<"
                    Condition = Val(Mid(Condition1, 2, Len(Condition1)))
                Case Is = ">"
                    StringOperator = ">"
                    Condition = Val(Mid(Condition1, 2, Len(Condition1)))
                Case Is = "="
                    StringOperator = "="
                    If IsNumeric(Mid(Condition1, 2, Len(Condition1))) And Not IsEmpty(Condition1) Then
                        Condition = Val(Mid(Condition1, 2, Len(Condition1)))
                    Else
                        Condition = UCase(Mid(Condition1, 2, Len(Condition1)))
                    End If
            End Select
    End Select
    Select Case StringOperator
        Case Is = ">="
            If Condition1Array(i, 1) < Condition Then
                ValuesArray(i, 1) = 0
                WeightsArray(i, 1) = 0
            End If
        Case Is = ">"
            If Condition1Array(i, 1) <= Condition Then
                ValuesArray(i, 1) = 0
                WeightsArray(i, 1) = 0
            End If
        Case Is = "<="
            If Condition1Array(i, 1) > Condition Then
                ValuesArray(i, 1) = 0
                WeightsArray(i, 1) = 0
            End If
        Case Is = "<"
            If Condition1Array(i, 1) >= Condition Then
                ValuesArray(i, 1) = 0
                WeightsArray(i, 1) = 0
            End If
        Case Else
            Select Case StringOperator
                Case Is = "="
                    If IsNumeric(Condition1Array(i, 1)) And Not IsEmpty(Condition1Array(i, 1)) Then
                        If Val(Condition1Array(i, 1)) <> Condition Then
                            ValuesArray(i, 1) = 0
                            WeightsArray(i, 1) = 0
                        End If
                    Else
                        If UCase(CStr(Condition1Array(i, 1))) <> Condition Then
                            ValuesArray(i, 1) = 0
                            WeightsArray(i, 1) = 0
                        End If
                    End If
                Case Is = "<>"
                    If IsNumeric(Condition1Array(i, 1)) And Not IsEmpty(Condition1Array(i, 1)) Then
                        If Val(Condition1Array(i, 1)) = Condition Then
                            ValuesArray(i, 1) = 0
                            WeightsArray(i, 1) = 0
                        End If
                    Else
                        If UCase(CStr(Condition1Array(i, 1))) = Condition Then
                            ValuesArray(i, 1) = 0
                            WeightsArray(i, 1) = 0
                        End If
                    End If
            End Select
    End Select
    
Next i

If ConditionRange2 Is Nothing Then
    GoTo FinalCalc
End If

'Condition 2

For i = LBound(ValuesArray) To UBound(ValuesArray)

    Select Case Left(Condition2, 2)
        Case Is = "<="
            StringOperator = "<="
            Condition = Val(Mid(Condition2, 3, Len(Condition2)))
        Case Is = ">="
            StringOperator = ">="
            Condition = Val(Mid(Condition2, 3, Len(Condition2)))
        Case Is = "<>"
            StringOperator = "<>"
            If IsNumeric(Mid(Condition2, 3, Len(Condition2))) And Not IsEmpty(Condition2) Then
                Condition = Val(Mid(Condition2, 3, Len(Condition2)))
            Else
                Condition = UCase(Mid(Condition2, 3, Len(Condition2)))
            End If
        
        Case Else
            Select Case Left(Condition2, 1)
                Case Is = "<"
                    StringOperator = "<"
                    Condition = Val(Mid(Condition2, 2, Len(Condition2)))
                Case Is = ">"
                    StringOperator = ">"
                    Condition = Val(Mid(Condition2, 2, Len(Condition2)))
                Case Is = "="
                    StringOperator = "="
                    If IsNumeric(Mid(Condition2, 2, Len(Condition2))) And Not IsEmpty(Condition2) Then
                        Condition = Val(Mid(Condition2, 2, Len(Condition2)))
                    Else
                        Condition = UCase(Mid(Condition2, 2, Len(Condition2)))
                    End If
            End Select
    End Select
    Select Case StringOperator
        Case Is = ">="
            If Condition2Array(i, 1) < Condition Then
                ValuesArray(i, 1) = 0
                WeightsArray(i, 1) = 0
            End If
        Case Is = ">"
            If Condition2Array(i, 1) <= Condition Then
                ValuesArray(i, 1) = 0
                WeightsArray(i, 1) = 0
            End If
        Case Is = "<="
            If Condition2Array(i, 1) > Condition Then
                ValuesArray(i, 1) = 0
                WeightsArray(i, 1) = 0
            End If
        Case Is = "<"
            If Condition2Array(i, 1) >= Condition Then
                ValuesArray(i, 1) = 0
                WeightsArray(i, 1) = 0
            End If
        Case Else
            Select Case StringOperator
                Case Is = "="
                    If IsNumeric(Condition2Array(i, 1)) And Not IsEmpty(Condition2Array(i, 1)) Then
                        If Val(Condition2Array(i, 1)) <> Condition Then
                            ValuesArray(i, 1) = 0
                            WeightsArray(i, 1) = 0
                        End If
                    Else
                        If UCase(CStr(Condition2Array(i, 1))) <> Condition Then
                            ValuesArray(i, 1) = 0
                            WeightsArray(i, 1) = 0
                        End If
                    End If
                Case Is = "<>"
                    If IsNumeric(Condition2Array(i, 1)) And Not IsEmpty(Condition2Array(i, 1)) Then
                        If Val(Condition2Array(i, 1)) = Condition Then
                            ValuesArray(i, 1) = 0
                            WeightsArray(i, 1) = 0
                        End If
                    Else
                        If UCase(CStr(Condition2Array(i, 1))) = Condition Then
                            ValuesArray(i, 1) = 0
                            WeightsArray(i, 1) = 0
                        End If
                    End If
            End Select
    End Select
    
Next i
If ConditionRange3 Is Nothing Then
GoTo FinalCalc
End If

'Condition 3
For i = LBound(ValuesArray) To UBound(ValuesArray)

    Select Case Left(Condition3, 2)
        Case Is = "<="
            StringOperator = "<="
            Condition = Val(Mid(Condition3, 3, Len(Condition3)))
        Case Is = ">="
            StringOperator = ">="
            Condition = Val(Mid(Condition3, 3, Len(Condition3)))
        Case Is = "<>"
            StringOperator = "<>"
            If IsNumeric(Mid(Condition3, 3, Len(Condition3))) And Not IsEmpty(Condition3) Then
                Condition = Val(Mid(Condition3, 3, Len(Condition3)))
            Else
                Condition = UCase(Mid(Condition3, 3, Len(Condition3)))
            End If
        
        Case Else
            Select Case Left(Condition3, 1)
                Case Is = "<"
                    StringOperator = "<"
                    Condition = Val(Mid(Condition3, 2, Len(Condition3)))
                Case Is = ">"
                    StringOperator = ">"
                    Condition = Val(Mid(Condition3, 2, Len(Condition3)))
                Case Is = "="
                    StringOperator = "="
                    If IsNumeric(Mid(Condition3, 2, Len(Condition3))) And Not IsEmpty(Condition3) Then
                        Condition = Val(Mid(Condition3, 2, Len(Condition3)))
                    Else
                        Condition = UCase(Mid(Condition3, 2, Len(Condition3)))
                    End If
            End Select
    End Select
    Select Case StringOperator
        Case Is = ">="
            If Condition3Array(i, 1) < Condition Then
                ValuesArray(i, 1) = 0
                WeightsArray(i, 1) = 0
            End If
        Case Is = ">"
            If Condition3Array(i, 1) <= Condition Then
                ValuesArray(i, 1) = 0
                WeightsArray(i, 1) = 0
            End If
        Case Is = "<="
            If Condition3Array(i, 1) > Condition Then
                ValuesArray(i, 1) = 0
                WeightsArray(i, 1) = 0
            End If
        Case Is = "<"
            If Condition3Array(i, 1) >= Condition Then
                ValuesArray(i, 1) = 0
                WeightsArray(i, 1) = 0
            End If
        Case Else
            Select Case StringOperator
                Case Is = "="
                    If IsNumeric(Condition3Array(i, 1)) And Not IsEmpty(Condition3Array(i, 1)) Then
                        If Val(Condition3Array(i, 1)) <> Condition Then
                            ValuesArray(i, 1) = 0
                            WeightsArray(i, 1) = 0
                        End If
                    Else
                        If UCase(CStr(Condition3Array(i, 1))) <> Condition Then
                            ValuesArray(i, 1) = 0
                            WeightsArray(i, 1) = 0
                        End If
                    End If
                Case Is = "<>"
                    If IsNumeric(Condition3Array(i, 1)) And Not IsEmpty(Condition3Array(i, 1)) Then
                        If Val(Condition3Array(i, 1)) = Condition Then
                            ValuesArray(i, 1) = 0
                            WeightsArray(i, 1) = 0
                        End If
                    Else
                        If UCase(CStr(Condition3Array(i, 1))) = Condition Then
                            ValuesArray(i, 1) = 0
                            WeightsArray(i, 1) = 0
                        End If
                    End If
            End Select
    End Select
    
Next i

FinalCalc:

dsum = Application.WorksheetFunction.Sum(WeightsArray)

For i = LBound(WeightsArray) To UBound(WeightsArray)
    WeightsArray(i, 1) = WeightsArray(i, 1) / dsum
Next i
For i = LBound(ValuesArray) To UBound(ValuesArray)
    ValuesArray(i, 1) = ValuesArray(i, 1) * WeightsArray(i, 1)
Next i

WeightedAvgIfs = Application.WorksheetFunction.Sum(ValuesArray)
End Function

Answer 1

这是具有其他一些优化的 paramarray 版本。 我确实跳过了你的 IsNumeric/Empty 检查，但总体思路是......

'opts = 1 or more pairs of Range, Condition values
Function WeightedAvgIfs(ByVal values As Range, ByVal weights As Range, ParamArray opts()) As Double

    Dim ValuesArray(), WeightsArray(), CondArray() As Variant
    Dim i As Long, opt As Long
    Dim dsum As Double
    Dim StringOperator As String
    Dim Cond As Variant, op As String, condVal, bOK As Boolean
    
    ValuesArray = values.Value
    WeightsArray = weights.Value
    'loop over any condition range + value pairs provided
    For opt = LBound(opts) To UBound(opts) Step 2
        CondArray = opts(opt).Value          'read the criteria range values
        Cond = Trim(opts(opt + 1))           'read the criteria
        op = Left(Cond, 2)                   'extract the criteria operator
        op = IIf(op = "<=" Or op = ">=" Or op = "<>", op, Left(op, 1))
        Cond = Trim(Right(Cond, Len(Cond) - Len(op))) 'extract the criteria value
        For i = LBound(ValuesArray) To UBound(ValuesArray)
            If ValuesArray(i, 1) <> 0 And WeightsArray(i, 1) <> 0 Then 'check not already excluded
                bOK = False
                condVal = CondArray(i, 1)
                Select Case op
                    Case "<=": bOK = (condVal <= Cond)
                    Case "<": bOK = (condVal < Cond)
                    Case ">=": bOK = (condVal >= Cond)
                    Case ">": bOK = (condVal > Cond)
                    Case "=": bOK = (condVal = Cond)
                    Case "<>": bOK = (condVal <> Cond)
                End Select
                If Not bOK Then 'filtered out in this run?
                    ValuesArray(i, 1) = 0
                    WeightsArray(i, 1) = 0
                End If
            End If
        Next i
    Next opt
    
    dsum = Application.WorksheetFunction.Sum(WeightsArray)
    For i = LBound(ValuesArray) To UBound(ValuesArray)
        ValuesArray(i, 1) = ValuesArray(i, 1) * (WeightsArray(i, 1) / dsum)
    Next i
    WeightedAvgIfs = Application.WorksheetFunction.Sum(ValuesArray)
End Function