如何在 VBA Excel UDF 参数中使用比较运算符?

How to use comparison operators in VBA Excel UDF arguments?

我将如何编写 UDF 以便它们在参数中接受比较运算符?

使用标准函数时,您可以这样写 =countif(range;x) 并且您会得到等于 x 的范围内的单元格数。

在 VBA 中复制这个函数看起来像这样:

Function countifUDF(rng As Range, x As Integer)
    count = 0
    For Each cell in rng.Cells
        If cell.Value = x Then
            count = count + 1
        Next cell
    countifUDF = sum
End Function

使用标准函数时,您可以将比较运算符传递给这样的函数 =countif(range;"<"&x) ,您将获得单元格的数量小于 x 的范围。

我如何在 UDF 中执行此操作?我的 UDF 作为 =countifUDF(range;"<"&x) 产生 #VALUE


解决方案

Function countifUDF(rng As Range, x As String)
Dim arr() As String
Dim count As Integer
Dim i As Integer

' breaking down x character by character and puts in array
ReDim arr(Len(x) - 1)
For i = 1 To Len(x)
    arr(i - 1) = Mid$(x, i, 1)
Next

' if the last character in x is not numeric i assume the user want to count matching strings
' Like allows the user to use wildcards, LCase makes the comparision case insensitive
If IsNumeric(arr(UBound(arr))) = False Then
    x = LCase(x)

    For Each cell In rng.Cells
        If LCase(cell.Value) Like x Then
            count = count + 1
        End If
    Next cell

' if the first char in x is numeric its pretty straight forward
ElseIf IsNumeric(arr(0)) = True Then
    For Each cell In rng.Cells
        If cell.Value = x Then
            count = count + 1
        End If
    Next cell

' if the first character in x is < and the second is numeric less-than operator is used
ElseIf arr(0) = "<" And IsNumeric(arr(1)) = True Then
    ' removing < from x
    x = Replace(x, "<", "")
    For Each cell In rng.Cells
        If cell.Value < x Then
            count = count + 1
        End If
    Next cell

ElseIf arr(0) = ">" And IsNumeric(arr(1)) = True Then
    x = Replace(x, ">", "")
    For Each cell In rng.Cells
        If cell.Value > x Then
            count = count + 1
        End If
    Next cell

' if the first char is < and the second is > the is not operator is used
ElseIf arr(0) = "<" And arr(1) = ">" Then
    x = Replace(x, "<", "")
    x = Replace(x, ">", "")
    For Each cell In rng.Cells
        If cell.Value <> x Then
            count = count + 1
        End If
    Next cell

ElseIf arr(0) = ">" And arr(1) = "=" Then
    x = Replace(x, ">", "")
    x = Replace(x, "=", "")
    For Each cell In rng.Cells
        If cell.Value >= x Then
            count = count + 1
        End If
    Next cell

ElseIf arr(0) = "<" And arr(1) = "=" Then
    x = Replace(x, "<", "")
    x = Replace(x, "=", "")
    For Each cell In rng.Cells
        If cell.Value <= x Then
            count = count + 1
        End If
    Next cell

End If

countifUDF = count

End Function

根据我得到的答案,在 VBA 中似乎没有方便的方法来处理 UDF 中的比较运算符,如果我错了请纠正我。我的解决方案支持带通配符的数字和字符串。起初我尝试使用带有 & 作为分隔符的拆分方法。显然 VBA 将 '">"&x' 标识为 '>x' 为什么我必须逐个字符拆分 x 并评估用户输入的比较运算符类型。

试试这个:

Function countifUDF(rng As Range, x As Integer)
    Dim cell As Range
    Dim Count As Integer

    Count = 0
    For Each cell In rng.Cells
        If cell.Value < x Then Count = Count + 1
    Next cell

    countifUDF = Count

End Function

UDF() 将第二个参数视为 String:

Function countifUDF(rng As Range, x As Variant) As Long
    Dim cell As Range, Count As Long, CH As String, VL As Long

    VL = Replace(Replace(x, ">", ""), "<", "")
    CH = Left(CStr(x), 1)
    Count = 0

    If CH = ">" Then
        For Each cell In rng.Cells
            If cell.Value > VL Then
                Count = Count + 1
            End If
        Next cell
    ElseIf CH = "<" Then
        For Each cell In rng.Cells
            If cell.Value < VL Then
                Count = Count + 1
            End If
        Next cell
    Else
        For Each cell In rng.Cells
            If cell.Value = x Then
                Count = Count + 1
            End If
        Next cell
    End If
    countifUDF = Count
End Function

在此示例中,CH 是第二个参数的第一个字符,VL 是第二个参数的数字部分。