Question

我一直在尝试编写MaxIf用户定义函数。代码完美地作为sub运行，但Do Loop作为一个没有错误的函数失败。我作为一个功能逐步介绍它，但没有发现任何线索。

Public Function udfMaxIf(criteria As Range, criteria_range As Range, max_range As Range)

Dim dblValues() As String
Dim lngMax As Long
Dim lngX As Long, intLastRow As Integer
Dim strSearch As String
Dim rngCriteria As Range, strFirst As String, strLast As String

strSearch = criteria.Value
'# setting after = to last row in range forces the Find to start from, and including, the first line of the range. Else it starts from top
'# row but doesn't search it until last.
With criteria_range
    intLastRow = .Rows.Count
    Set rngCriteria = .Find(strSearch, after:=criteria_range.Cells(intLastRow, 1), LookIn:=xlValues, searchorder:=xlByRows, searchdirection:=xlNext)
End With

If Not rngCriteria Is Nothing Then
    '# set the value of the first appearance of rngCriteria to array(0)
    ReDim dblValues(0)
    strFirst = rngCriteria.Address
    strLast = criteria_range.Find(strSearch, LookIn:=xlValues, searchorder:=xlByRows, searchdirection:=xlPrevious).Address
    dblValues(0) = Cells(rngCriteria.Row, max_range.Column).Value
    '# add subsequent values to the array but break when it reaches last row. If this was only value it would have been picked up above.
    Do Until rngCriteria.Address = strLast
        Set rngCriteria = criteria_range.FindNext(rngCriteria)
        ReDim Preserve dblValues(UBound(dblValues) + 1)
        dblValues(UBound(dblValues)) = Cells(rngCriteria.Row, max_range.Column).Value
    Loop
End If

On Error GoTo UBound_handler:
    lngMax = dblValues(0)
    For lngX = 0 To UBound(dblValues)
        If dblValues(lngX) > lngMax Then
            lngMax = dblValues(lngX)
        End If
    Next lngX
On Error Resume Next
udfMaxIf = lngMax
Exit Function
UBound_handler:
If Err.Number = 9 Then
    MsgBox "Criteria not found in criteria range", vbInformation
Else:
    MsgBox Err.Number & ": " & Err.Description
End If
Exit Function
End Function

方法可以改进，但我更关心的是弄清楚为什么它不能起作用。感谢。

Answer 1

就个人而言，我更喜欢迭代数组，因为我发现它比其他方法更可靠，更快。像这样的东西可以作为MaxIf UDF使用：

Public Function MaxIf(ByVal rCriteria As Range, ByVal sCriteria As String, ByVal rMax As Range) As Variant

    Dim aCrit As Variant
    Dim aValues As Variant
    Dim i As Long, j As Long
    Dim dMax As Double

    aCrit = rCriteria.Value
    aValues = rMax.Value
    If rCriteria.Rows.Count & "," & rCriteria.Columns.Count <> rMax.Rows.Count & "," & rMax.Columns.Count Then
        MaxIf = CVErr(xlErrRef)
        Exit Function
    End If

    If Not IsArray(aCrit) Then
        If LCase(aCrit) Like LCase(sCriteria) Then MaxIf = aValues Else MaxIf = 0
    Else
        dMax = -10 ^ 308
        For i = 1 To UBound(aCrit, 1)
            For j = 1 To UBound(aCrit, 2)
                If LCase(aCrit(i, j)) Like LCase(sCriteria) Then
                    If IsNumeric(aValues(i, j)) Then
                        If aValues(i, j) > dMax Then dMax = aValues(i, j)
                    End If
                End If
            Next j
        Next i
        If dMax > -10 ^ 308 Then MaxIf = dMax Else MaxIf = 0
    End If

End Function

Answer 2

dblValues(0) = Cells(rngCriteria.Row, max_range.Column).Value

这样的行可能会有问题，因为你没有将Cells()限定为特定的工作表，所以它将默认为Activesheet的任何内容（除非你在表单模块中有这个代码）

Answer 3

示例数据从单元格A1开始，单元格G2中的值为“A”，将UDF称为=foo(G2, A1:D6)

A   B   C   D
E   F   G   H
I   J   A   B
C   D   E   F
G   H   I   J
A   B   C   D

这是一个简单的例子，你可以作为函数或子函数运行。

Public Function foo(criteria As Range, criteria_range As Range)

Dim rngCriteria As Range
Dim intLastRow As Long
Dim strSearch$, strFirst$, strLast$
Dim ret
strSearch = criteria.Value
With criteria_range
    intLastRow = .Rows.Count
    Set rngCriteria = .Find(strSearch, after:=criteria_range.Cells(intLastRow, 1), LookIn:=xlValues, searchOrder:=xlByRows, searchdirection:=xlNext)
End With
If Not rngCriteria Is Nothing Then

strFirst = rngCriteria.Address
strLast = criteria_range.Find(strSearch, LookIn:=xlValues, searchOrder:=xlByRows, searchdirection:=xlPrevious).Address

Do Until rngCriteria.Address = strLast
    Set rngCriteria = criteria_range.FindNext(rngCriteria)
Loop
End If
ret = rngCriteria.Address
foo = ret  '// Comment this line if calling as Sub
Debug.Print ret
End Function

单步执行代码，当从工作表中作为UDF运行时，您将观察到Do循环在第二次传递时无声地失败，但是当从Sub调用时，它将无错误地执行VBE即刻疼痛。

UDF有一些限制（在这篇知识库文章中解释得不是很好）：

https://support.microsoft.com/en-us/kb/170787

快速谷歌search suggests that Find是禁止使用的方法之一，尽管似乎并非如此。像你这样的问题＆amp;我观察到FindNext没有返回任何内容，而Do循环依赖于非Nothing来查询Address属性。如果FindNext被禁止，我会指望该表达式出现错误/无声失败，所以可能这是一个错误。

由于Find未导致错误，因此可以重新使用UDF以仅在循环中使用Find方法，而不是FindNext方法。

Public Function newfoo(criteria As Range, criteria_range As Range)
Dim rngCriteria As Range
Dim intLastRow As Long
Dim strSearch$, strFirst$, strLast$
Dim ret
strSearch = criteria.Value

With criteria_range
    intLastRow = .Rows.Count
    Set rngCriteria = .Find(strSearch, After:=criteria_range.Cells(intLastRow, 1), LookIn:=xlValues, searchOrder:=xlByRows, searchdirection:=xlNext)
End With
If Not rngCriteria Is Nothing Then
    ret = rngCriteria.Address
    strFirst = rngCriteria.Address
    strLast = criteria_range.Find(strSearch, LookIn:=xlValues, searchOrder:=xlByRows, searchdirection:=xlPrevious).Address
    Do
        Set rngCriteria = criteria_range.Find(strSearch, After:=rngCriteria, LookIn:=xlValues, searchOrder:=xlByRows, searchdirection:=xlNext)
        If Not rngCriteria Is Nothing Then
            ret = ret & "|" & rngCriteria.Address
            If rngCriteria.Address = strLast Then
                Exit Do
            End If
        End If
    Loop
End If
Debug.Print ret
foo = ret
End Function

或者您可以重新配置FindNext个参数。（的未测试）

Answer 4

感谢所有的想法和建议。之前我不知道UDF以不同的方式工作到常规潜艇。

最终我使用@tigeravatar数组公式扩展到多MAXIF，并提供以下帮助： MaxIF with multi-criteria

Excel MaxIF函数失败但作为sub运行

4 个答案: