Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Выделение дубликатов из несколькоих столбцов
 
#1
20.08.2019 17:40:30
Вроде как абосютно тривиальный вопрос. Поиск не помог.
Есть дубликаты разбросанные по нескольким столбцам. Необходимо проверить столбец 1 на дубли из 2и3.
Это только пример задачи. Таких столбцов может быть 4-7 (а иногда до 40 и более) строк в столбцах по-разному 10к -1млн. Сводить их в один не вариант по причине размера. 5-40 раз прогонять ПЛЕКСОМ тоже муторно и часто ошибки: пропуски и повторы. Этим приходится заниматься ежедневно. Макрос пробовал писать, но работает крайне медленно. Плекс работает только по 2 столбцам, а если их больше, то игнорирует. Подскажите плс куда рыть.
 
 
 
#2
20.08.2019 17:49:04
Читайте правила. Сделайте файл пример. В теории я бы попробовал решить эту проблему через условное форматирование с формулой СЧЁТЕСЛИ.

UPD. Перечитал ещё раз про 10к-1 млн. строк и понял, что моё условное форматирование не прокатит, но при наличии файла примера кто-нить наверное на PQ вариант предложит...
Изменено: Wiss - 20.08.2019 17:52:27
Я не волшебник, я только учусь.
 
 
 
#3
26.08.2019 10:43:37
Подгрузил файл пример того что мне надо. Если у кого есть мысли как организовать такую проверку очень прошу помочь.
 
 
 
#4
26.08.2019 11:21:08
Попробуйте вот таким макросом. На массивах должно быть не очень долго.
Сначала выделяете проверяемый список. Затем столбцы, где могут быть дубли.
Код
Sub FindDuplicates()

Dim arr1, arr2, rng As Range
Dim n As Long, x As Long, y As Long
Dim bDup As Boolean

Set rng = Application.InputBox("Проверяемый массив", "Выберите проверяемый массив", Type:=8)
arr2 = Application.InputBox("Массив дублей", "Выберите массив дубликатов", Type:=8)
arr1 = rng

For n = 1 To UBound(arr1, 1)
    bDup = False
    For x = 1 To UBound(arr2, 1)
        For y = 1 To UBound(arr2, 2)
            If arr1(n, 1) = arr2(x, y) Then
                bDup = True
                Exit For
            End If
        Next y
        If bDup Then Exit For
    Next x
    If bDup Then rng(n, 1).Interior.Color = vbRed
Next n

MsgBox "Готово"

End Sub
Изменено: Sceptic - 26.08.2019 11:24:17
 
 
 
#5
26.08.2019 11:36:10
Еще вариантик:
Код
Sub FindDuplicates2()

Dim rng As Range, rng1 As Range, rng2 As Range

Set rng1 = Application.InputBox("Проверяемый массив", "Выберите проверяемый массив", Type:=8)
Set rng2 = Application.InputBox("Массив дублей", "Выберите массив дубликатов", Type:=8)

For Each rng In rng1
    If Not rng2.Find(rng, LookAt:=xlWhole) Is Nothing Then rng.Interior.Color = vbRed
Next rng

MsgBox "Готово"

End Sub
 
 
 
#6
26.08.2019 11:40:57
Код
Sub check()
Dim r1&, r2&, b As Long
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
b = Cells(1, Columns.Count).End(xlToLeft).Column
 For b = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
  For r1 = 1 To lLastRow
    For r2 = 1 To lLastRow
      If Cells(r1, 1) = Cells(r2, b) Then Cells(r1, 1).Interior.Color = vbRed
    Next
   Next
  Next
End Sub
Изменено: Hellmaster - 26.08.2019 13:25:10
 
 
 
#7
26.08.2019 16:23:47

Спасибо большое за участие. Какие лаконичные решения вы предлагаете, красотища.

К сожалению на таких больших выборках любой предложенный вариант работает крайне медленно - меряется как минимум десятками минут, не дождался просто прервал. На малых списках все отлично. Не знаю как это сделано в плексе, но там проверка двух списков по миллиону записей это дело секунд.

В любом случае, Sceptic, Hellmaster, спасибо за такие варианты. Они очень хорошо  пополнят мои знания.

Может кто может модифицировать плекс? Судя по декларациям, автор вроде как не против. Я даже готов поучавствовать финансово (в пределах моих возможностей).

Изменено: Lobster - 26.08.2019 16:25:34
 
 
 
#8
26.08.2019 16:29:34
Lobster, так вы прямо по адресу это дело и предложите. Есть специально отведенное место для таких предложений.
Выделять приницпиально цветом? Если устроит к табличке столбец прицепить с признаком наличия дубликата, то можно предложить вариант решения на PQ:
Код
let
    Source = Table.AddIndexColumn(Excel.CurrentWorkbook(){[Name="ПроверкаДублей"]}[Content], "Индекс", 0, 1),
    RemovedOtherColumns = Table.SelectColumns(Source, List.Difference( Table.ColumnNames(Source), {"ПризнакДубля"}) ),
    UnpivotedOtherColumns = Table.UnpivotOtherColumns(RemovedOtherColumns, {"Проверяем это на дубли из списков 1-3"}, "Атрибут", "Значение"),
    Difference = List.Difference( RemovedOtherColumns[#"Проверяем это на дубли из списков 1-3"], List.Distinct(UnpivotedOtherColumns[Значение]) ),
    Check = Table.AddColumn( Table.FromList(Difference, Splitter.SplitByNothing()), "Признак", each "Нет" ),
    Join = Table.Join( RemovedOtherColumns, {"Проверяем это на дубли из списков 1-3"}, Check, {"Column1"}, JoinKind.LeftOuter),
    Final = Table.AddColumn(Join, "ПризнакДубля", each if [Признак] = null then "Да" else [Признак]),
    SortedRows = Table.Sort(Final,{{"Индекс", Order.Ascending}}),
    RemovedColumns = Table.RemoveColumns(SortedRows,{"Column1", "Индекс", "Признак"})
in
    RemovedColumns

Можете проверить скорость.
Изменено: PooHkrd - 26.08.2019 17:01:21
Вот горшок пустой, он предмет простой...
 
 
 
#9
26.08.2019 18:13:46
PooHkrd, Спасибо большое за вашу реализацию. Никогда риньше не пользовался этим интересным инструментом. Она действительно работает очень быстро (на моем лаптопе) списки в пару миллионов проверила не более чем за пару минут.  Единственное так это некоторое неудобство самого PQ, а так это супер вещь.

Проблему по вашему совету описал с предложениях. Может кто отзовется.
 
 
 
Страницы: 1
Наверх