Excel VBA查找相邻单元格中具有最大值的字符串

Question

我有一列包含一些文本，另一列包含数字，如下所示：

--------  -----
| GREY |  | 4 |
--------  -----
| BLUE |  | 3 |
--------  -----
| BLUE |  | 5 |
--------  -----
| GREY |  | 1 |
--------  -----

我想找到所有包含特定字符串的单元格（假设是“ Blue”，见上文），然后是相邻单元格中具有最高值的单元格（此处将为“ 5”）。

我知道FIND方法，以及如何获得范围的最大值（Application.WorksheetFunction.Max），但我不知道如何将两者结合起来。

有人可以帮我吗？ 在此先感谢您，对不起我的英语！

Answer 1

您可以将MaxIfs用于较新的版本，如下所示：

Function MaxIf(maxRange As Range, conditionRange As Range, conditionString As String) As Double

    If Application.Version >= 16 Then
        MaxIf = Application.WorksheetFunction.MaxIfs(maxRange, conditionRange, conditionString)
    Else
        Dim FormulaString As String
        FormulaString = "MAX(IF(" & conditionRange.Address & "=""" & conditionString & """, " & maxRange.Address & ", -9e99))"
        MaxIf = CDbl(conditionRange.Parent.Evaluate(FormulaString))
    End If
End Function

'''''

Sub test()
    MsgBox MaxIf(Sheet1.Range("B:B"), Sheet1.Range("A:A"), "blue")
End Sub

Answer 2

较新的Excel版本具有MAXIFS函数。 如果您收到#NAME？ 尝试使用此工作表功能时出现错误，请尝试以下替代方法之一。

=aggregate(14, 7, b2:b5/(a2:a5="blue"), 1)
=max(index(b2:b5-(a2:a5<>"blue")*1e99, , ))

使用VBA将范围对象var设置为延续最大数量的单元格。

Sub main()

    Debug.Print maxnumfromcolor(Range("b2:b5"), Range("a2:a5"), "blue")

    Dim rng As Range

    Set rng = maxrngfromcolor(Range("b2:b5"), Range("a2:a5"), "blue")
    Debug.Print rng.Address

End Sub

Function maxnumfromcolor(rng1 As Range, rng2 As Range, str As String) As Double

    Dim i As Long

    Set rng1 = Intersect(rng1, rng1.Parent.UsedRange)
    Set rng2 = rng2.Resize(rng1.Rows.Count, rng1.Columns.Count)

    maxnumfromcolor = 0

    For i = 1 To rng1.Cells.Count

        If LCase(rng2.Cells(i).Value2) = LCase(str) Then
            maxnumfromcolor = _
                Application.Max(rng1.Cells(i).Value2, maxnumfromcolor)
        End If

    Next i

End Function

Function maxrngfromcolor(rng1 As Range, rng2 As Range, str As String) As Range

    Dim i As Long, mx As Double

    Set rng1 = Intersect(rng1, rng1.Parent.UsedRange)
    Set rng2 = rng2.Resize(rng1.Rows.Count, rng1.Columns.Count)

    mx = 0

    For i = 1 To rng1.Cells.Count

        If LCase(rng2.Cells(i).Value2) = LCase(str) Then
            If mx < rng1.Cells(i).Value2 Then
                Set maxrngfromcolor = rng1.Cells(i)  'use rng2 for 'blue cell
                mx = rng1.Cells(i).Value2
            End If
        End If

    Next i

End Function