Страницы: 1
RSS
подтянуть максимальное значение для критерия из двух столбцов значений
 
Приветствую.

Имеется следующая задача:

заполняю таблицу где необходимо подтянуть макс значение по критерию
КритерийМакс значение
1
2
3
n
из свода данных вида
Диапазон   критериев Столбец со   значением (1)Столбец со   значением (2)

Хотел воспользоваться функцией максесли (maxifs) но выяснилось, что работаю на версии 2013.

думаю, что в 2016 написал бы формулу в стиле max(maxifs(столбец со значением 1; диапазон критериев; критерий 1);maxifs(столбец со значением 2; диапазон критериев; критерий 1).


в 2013 версии в голову никакой замены не приходит.

Спасибо.
Изменено: evtu1993 - 16.03.2018 17:07:51 (добавил пример)
 
evtu1993, хороший файл-пример  - невидимый файл-пример.
Не бойтесь совершенства. Вам его не достичь.
 
UDF
Код
Function МАКСЕСЛИМН(rng As Range, ParamArray Cond())
Dim arr(), arrFlag(), arrCond(), arrMax()
Dim I&, J&, N&
On Error Resume Next
arr = Intersect(rng.Parent.UsedRange, rng).Value
For I = LBound(arr) To UBound(arr)
    ReDim arrFlag(Int(UBound(Cond) / 2))
    For J = LBound(Cond) To UBound(Cond) Step 2
        If IsObject(Cond(J)) Then arrCond = Intersect(Cond(J).Parent.UsedRange, Cond(J)).Value
        If IsNumeric(arrCond(I, 1)) And Cond(J + 1) Like "[><=]" Then
            If Application.Evaluate(Replace(arrCond(I, 1), ",", ".") & Cond(J + 1)) Then arrFlag(Int(J / 2)) = True
        Else
            If arrCond(I, 1) Like Cond(J + 1) Then arrFlag(Int(J / 2)) = True
        End If
    Next
    If WorksheetFunction.And(arrFlag) = True Then
        If Err = 0 Then
            ReDim Preserve arrMax(N)
            arrMax(N) = arr(I, 1)
            N = N + 1
        Else
            Err.Clear
        End If
    End If
Next
МАКСЕСЛИМН = Application.Max(arrMax)
End Function
Изменено: Sanja - 16.03.2018 19:13:04
Согласие есть продукт при полном непротивлении сторон
 
UDF получилась не из быстрых. Обычный макрос. Нажать на MAX
Код
Sub MAXIFS()
Dim arrCond(), arr(), iArr(), I&, J&
Dim dic As Object
With Worksheets("таблица")
    arrCond = .Range("B4:B" & .Cells(.Rows.Count, "B").End(xlUp).Row).Value
End With
With Worksheets("Sheet12")
    arr = .Range("B3:D" & .Cells(.Rows.Count, "B").End(xlUp).Row).Value
End With
On Error Resume Next
Set dic = CreateObject("Scripting.Dictionary")
For I = 1 To UBound(arr)
    Erase iArr
    For J = 0 To 1
        If arr(I, J + 2) <> Empty Then
            ReDim Preserve iArr(J)
            iArr(J) = arr(I, J + 2)
        End If
    Next
    dic.Add CStr(arr(I, 1)), iArr
    If Err <> 0 Then
        iArr = dic(CStr(arr(I, 1)))
        For J = 0 To 1
        If arr(I, J + 2) <> Empty Then
            ReDim Preserve iArr(UBound(iArr) + 1)
            iArr(UBound(iArr)) = arr(I, J + 2)
        End If
        Next
        dic(CStr(arr(I, 1))) = iArr
        Err.Clear
    End If
Next
ReDim arrMax(1 To UBound(arrCond), 0)
For I = 1 To UBound(arrCond)
    arrMax(I, 0) = IIf(dic.Exists(CStr(arrCond(I, 1))), Application.Max(dic(CStr(arrCond(I, 1)))), Empty)
Next
With Worksheets("таблица").Range("D4").Resize(UBound(arrMax))
    .ClearContents
    .Value = arrMax
End With
End Sub
Согласие есть продукт при полном непротивлении сторон
 
При условии что нет отрицательных значенй. на выбор:
=AGGREGATE(14;6;(B4=Sheet12!$B$3:$B$1897)*Sheet12!$C$3:$D$1897;1)
Массивные {}
=LARGE((B4=Sheet12!$B$3:$B$1897)*Sheet12!$C$3:$D$1897;1)
=MAX((B4=Sheet12!$B$3:$B$1897)*Sheet12!$C$3:$D$1897)

Отрицательные тоже можно обработать, если нужно

А также сводная с вычисляемым полем

Изменено: БМВ - 16.03.2018 21:16:41
По вопросам из тем форума, личку не читаю.
Страницы: 1
Наверх