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