Страницы: 1
RSS
Максимальное значение в столбце 2 для каждого уникального значения из столбца 1
 
День добрый. Подскажите пожалуйста как решить задачу. Имеется таблица из двух стобиков 1 (№ эл) и 2 (Ny). Необходимо найти максимальное значение в столбце 2 для каждого уникального значения в столбце 1. Сейчас решаю вопрос ручками. Сначала делаю две сортировки по столбцу 1 и по столбцу 2 обе по возрастанию. Получаю несколько диапазонов, в которых первая строка является искомой. Далее для удобства сложения удаляю все кроме искомых строк.
Данные процесс довольно рутинный (таблиц бывает много и размером больше чем в примере). Как можно автоматизировать данный процесс ?
 
Код
Sub ElNu()
    Dim arr As Variant
    Dim y As Long
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim sh As Worksheet
    Set sh = ActiveSheet
    With sh
        y = .Cells(.Rows.Count, 1).End(xlUp).Row
        arr = .Range(.Cells(1, 1), .Cells(y, 2))
    End With
    
    dic.Item(arr(1, 1)) = arr(1, 2)
    For y = 2 To UBound(arr, 1)
        If Not dic.Exists(arr(y, 1)) Then
            dic.Item(arr(y, 1)) = arr(y, 2)
        Else
            If dic.Item(arr(y, 1)) > arr(y, 2) Then
                dic.Item(arr(y, 1)) = arr(y, 2)
            End If
        End If
    Next
    
    If dic.Count > 0 Then
        With Workbooks.Add(1)
            With .Sheets(1)
                .Cells(1, 1).Resize(dic.Count) = Application.Transpose(dic.keys())
                .Cells(1, 2).Resize(dic.Count) = Application.Transpose(dic.Items())
                
                sh.Range("A1:B1").Copy
                .Range("A1:B1").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                sh.Range("A2:B2").Copy
                .Cells(2, 1).Resize(dic.Count - 1, 2).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            End With
            .Saved = True
        End With
    End If
End Sub
Изменено: МатросНаЗебре - 15.04.2021 09:35:29 (Добавил копирование форматов.)
 
Спасибо за помощь !
 
Если Вас интересует формульное решение, то посмотрите такой вариант
Код
=ЕСЛИ(СЧЁТЕСЛИ($A$1:$A2;$A2)>1;"";МАКСЕСЛИ($B$1:$B$23;$A$1:$A$23;$A2))
 
Вариант названия темы:
Максимальное значение в столбце 2 для каждого уникального значения из столбца 1.
 
В Вашем примере нужно вывести минимальное значение.
Предлагаю две форулы
для Excel2010
Код
=AGGREGATE(15;6;исходн!B$2:B$178/(исходн!A$2:A$178=A2);1)
и так как у Вас все значения отрицательные то
Код
=-MAX(INDEX((исходн!A$2:A$178=итог!A2)*ABS(исходн!B$2:B$178);0))
Страницы: 1
Наверх