Страницы: 1
RSS
Excel, поиск дублей и выборка наибольшего значения из другого столбца
 
Всем привет, друзья помогите пожалуйста найти решения для вот такой задачи:
Есть таблица, столбец А Фамилии, столбец B количество.
Мне нужно чтобы в столбце А остались только уникальные значения с наибольшим количеством, т.е  почистить дубли и при этом чтобы из дублей остались только те у которых наибольшее количество. Пример в файле.
В реале таблица большая больше тысячи строк, глазами всё просмотреть и отсортировать сложно.  
 
Обычная сводная
По вопросам из тем форума, личку не читаю.
 
, Сводная будет суммировать все значения, а мне нужно оставить только наибольшие.......
 
Цитата
Вадим написал: Сводная будет...
...делать то, что ей сказать делать. Изучайте инструмент.
По вопросам из тем форума, личку не читаю.
 
Цитата
написал:
Изучайте инструмент.
Спасибо за совет, в принципе можно было написать изучайте "excel". Сразу всё стало понятно.  
 
Вадим,  а чего Вы обижаетесь? Вы же просили найти решение - Вам подсказали, с помощью какого инструмента это можно сделать.
А я бы делал макросом.
 
Я не обижаюсь, я просто  подчеркнул факт очень сухого ответа на мой вопрос из которого мне понятно только одно, что нужно идти изучать инструмент.
Это безусловно хорошая рекомендация и я ей конечно же воспользуюсь.
То что это можно сделать через сводную или через макрос это понятно, вопрос был в том как это сделать?
Ранее я думал что на данном форуме люди получают ответы на на вопросы в тех областях где они не являются профи, (если я не прав поправьте меня).
А сейчас меня отправляют изучать инструмент.  Считаю это не помощью а отпиской.  
 
Цитата
Юрий М написал:
А я бы делал макросом.
теперь еще   макросы учить?  :D
По вопросам из тем форума, личку не читаю.
 
, так просто при добавлении поля в значение в параметрах полей выбрать в опциях - максимум
Не бойтесь совершенства. Вам его не достичь.
 
Благодарю!
 
, или макрос используйте
Код
Sub mrshkei()
Dim arr, arr2, i As Long, n As Long, lr As Long, k As Long, col As New Collection
lr = Cells(Rows.Count, 1).End(xlUp).Row
arr = Range("A2:B" & lr)
For i = LBound(arr) To UBound(arr)
    On Error Resume Next: If arr(i, 1) <> "" Then col.Add arr(i, 1), CStr(arr(i, 1))
Next i
ReDim arr2(1 To col.Count, 1 To 2)
For n = 1 To col.Count
x = 0
    For i = LBound(arr) To UBound(arr)
        If arr(i, 1) = col(n) And arr(i, 2) > x Then x = arr(i, 2)
    Next i
    arr2(n, 1) = col(n)
    arr2(n, 2) = x
Next n
Range("D2").Resize(UBound(arr2), 2) = arr2
End Sub
Изменено: Mershik - 28.11.2021 14:49:07
Не бойтесь совершенства. Вам его не достичь.
 
Цитата
Вадим написал:
Считаю это не помощью а отпиской.
А как Вы понимаете ПОМОЩБ? У Вас не получается что-то конкретно? Или Вам нужно готовое решение с нуля? Это будет помощь? Нет - это называется сделать за Вас.
Цитата
Вадим написал:

Ранее я думал что на данном форуме люди получают ответы на на вопросы в
Вадим, так Вы же получили ответы )) Думаю, что можно добавить ещё, что можно решить с помощью PQ, но такой ответ Вас ведь тоже не устроит. Если же Вам нужно готовое решение, то так и скажите - и я напишу Вам макрос.
Изменено: Юрий М - 28.11.2021 14:56:30
 
Mershik, почему на выходе два Григория? )
 
Цитата
Юрий М написал:
почему на выходе два Григория? )
по тому что второй ГригоЙрий
По вопросам из тем форума, личку не читаю.
 
Да, вижу. К тому же у первого Григория хвост в виде пробела ))
 
Mershik, Спасибо огромное!
Изменено: Вадим - 28.11.2021 15:10:50
 
формулы:
Код
=УНИК(Таблица1[Имя])
=МАКС(ФИЛЬТР(Таблица1;Таблица1[Имя]=H2))

pq:
Код
let
    Source = Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content],
    q = Table.Group(Source, {"Имя"}, {"Количество", each Table.Sort(_, {"Количество", Order.Descending})[Количество]{0}})
in
    q
 
Я бы просто в столбце С записал уникод - сцепить(а;в). А далее удалить дубликаты
 
Mershik Я у Вас немного кода украл.

Код
Sub SEN45()
Dim arr1, Tp1, i&, lr&, col As New Collection
lr = Cells(Rows.Count, 1).End(xlUp).Row
arr1 = Range("A2:B" & lr): ReDim Tp1(1)
    For i = 2 To UBound(arr1)
    On Error Resume Next
If arr1(i, 1) <> "" Then
    Tp1(0) = arr1(i, 1): Tp1(1) = arr1(i, 2): col.Add Tp1, CStr(arr1(i, 1))
If Err <> 0 And col(arr1(i, 1))(1) < arr1(i, 2) Then col.Remove (arr1(i, 1)): _
            col.Add Tp1, CStr(arr1(i, 1)): Err = 0
End If
    Next i: On Error GoTo 0: ReDim arr1(1 To col.Count, 1 To 2)
        For i = 1 To col.Count
            arr1(i, 1) = col(i)(0): arr1(i, 2) = col(i)(1)
        Next
Range("D2").Resize(UBound(arr1), 2) = arr1
End Sub

Хотя проще всего со словарем

Код
Sub SEN46()
Dim arr1, i&, lr&, dic1
Set dic1 = CreateObject("scripting.dictionary")
lr = Cells(Rows.Count, 1).End(xlUp).Row
arr1 = Range("A2:B" & lr)
    For i = 2 To UBound(arr1)
If Not dic1.exists(arr1(i, 1)) Then dic1(arr1(i, 1)) = arr1(i, 2) Else _
If dic1(arr1(i, 1)) < arr1(i, 2) Then dic1(arr1(i, 1)) = arr1(i, 2)
Next i
Range("D2").Resize(dic1.Count) = WorksheetFunction.Transpose(dic1.keys)
Range("E2").Resize(dic1.Count) = WorksheetFunction.Transpose(dic1.Items)
End Sub

Изменено: Евгений Смирнов - 28.11.2021 17:34:19
 
Цитата
Василий Нисс написал:
сцепить(а;в). А далее удалить дубликаты
А это даст нужный результат?
 
Цитата
Юрий М написал:
А это даст нужный результат?
смотря какой результат считать нужным  :D
По вопросам из тем форума, личку не читаю.
 
Ребята, всем большое спасибо за отзывчивость и помощь.
Страницы: 1
Наверх