Excel VBA Find String с наибольшим значением в соседней ячейке

Question

У меня есть столбец с некоторым текстом, а другой - с номерами, как показано ниже:

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

Я хотел бы найти все ячейки, содержащие определенную строку (скажем, «Синий», см. Выше),затем тот, который имеет наибольшее значение в соседней ячейке (что дает здесь «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