Выделение повторяющихся строк

Question

Я хотел бы выделить повторяющиеся строки в Excel VBA. Предположим, у меня есть следующий пример таблицы со столбцами A, B, C и D для тестирования:

A  B  C  D (Strings) 

1  1  1  dsf 
2  3  5  dgdgdgdg 
1  1  1  dsf 
2  2  2  xxx 
6  3  4  adsdadad 
2  2  2  xxx 

повторяющиеся строки должны быть выделены в любой цвет, например серый. Я смотрю идеально для быстрого выполнения кода, так как он будет использоваться для довольно больших таблиц. Примечание. Существуют решения для выделения повторяющихся ячеек (но не дубликатов строк). Я не знаю, как определить, являются ли строки дублирующими и в то же время, как это сделать быстро, то есть без вложенного цикла. Решение должно быть в VBA (не Excel).

Каков наилучший/самый быстрый способ достичь этого?

Answer 1

я испытал 3 различных подходов к файлу образца link от комментария OP в. Вероятно реализации VBA не были оптимальными, но ниже приведены результаты со средним временем 100 проходов:

1) Условное форматирование с использованием:

а) SUMPRODUCT конкатенация колонны - 3s

б) COUNTIFS с полным ссылка на столбец - 1.9s

с) COUNTIFS ссылок используются диапазоны - 0.2s

2) сортировка диапазона по всем столбцам, сравнивающие строки по ро ж, сортировка назад - 0.3с

3) Используя расширенный фильтр 3.5с

Вот код для самого быстрого способа:

Sub CF1() 

    Application.ScreenUpdating = False 

    Dim sFormula As String 
    Dim rRng As Range 
    Dim nCol As Integer, i As Integer 

    Set rRng = Range("A1").CurrentRegion 
    nCol = rRng.Columns.Count 

    'build the formula 
    sFormula = "=COUNTIFS(" 

    For i = 1 To nCol 
     sFormula = sFormula & rRng.Columns(i).Address & "," & _ 
     rRng.Cells(1, i).Address(False, True) 
     If i < nCol Then sFormula = sFormula & "," 
    Next 
    sFormula = sFormula & ")>1" 

    'write the formula in helper cell to get it's local version 
    rRng.Cells(1, nCol + 1).Formula = sFormula 

    rRng.FormatConditions.Delete 
    With rRng.FormatConditions.Add(Type:=xlExpression, _ 
      Formula1:=rRng.Cells(1, nCol + 1).FormulaLocal) 
     .Interior.ThemeColor = xlThemeColorAccent3 
    End With 

    rRng.Cells(1, nCol + 1).Clear 

    Application.ScreenUpdating = True 
End Sub 

Answer 2

добавить условное форматирование с помощью следующей формулы SUMPRODUCT (или COUNTIFS)

=SUMPRODUCT(($A$1:$A$6&$B$1:$B$6&$C$1:$C$6=$A1&$B1&$C1)*1)>1

Пояснение:

SUMPRODUCT удобно работать с диапазонами, которые вам нужны для управления до проверки состояния. В этом случае я объединяю A, B & C столбцов в диапазоне и сравниваю их с конкатенацией текущей строки. Затем я преобразовываю массив TRUE/FALSE в массив 1/0 путем умножения на 1, а часть SUMSUMPRODUCT суммирует строки, где условие истинно, и дает мне повторяющиеся строки (все вхождения). Если у вас небольшой диапазон, используя оценку формулы, вы можете четко видеть, как это работает.

Это быстрое решение, но производительность не идеальна, я использую ее для обнаружения дубликатов или создания последовательных номеров.

Решение от комментариев, предложенных ponydeer - более высокая производительность

на основе сортировки предполагая, требует, чтобы добавить ключевой столбец, положить в авто фильтры и сортировки по ключу, а затем сделать обусловливающие ключевого столбца:

Answer 3

Сортируйте диапазон первых относительно всех столбцов

Workbooks(1).Sheets(1).Range("A:C").Sort Key1:=Workbooks(1).Sheets(1).Range("A:A"), Order1:=xlAscending, Key2:=Workbooks(1).Sheets(1).Range("B:B"), Order2:=xlAscending, Key3:=Workbooks(1).Sheets(1).Range("C:C"), Order3:=xlAscending, Orientation:=xlSortRows 

Затем цикл по всем строкам го сравнить их с тем, над ними

Dim a As Application 
Set a = Application 

For i=1 to 1000 ' here you need to set the number of rows you have 
    if Join(a.Transpose(a.Transpose(ActiveSheet.Rows(i).Value)), Chr(0)) = _ 
    Join(a.Transpose(a.Transpose(Sheets(1).Rows(i+1).Value)), Chr(0)) then 

     Sheets(1).Range(i+1 & ":" & i+1).EntireRow.Interior.Color = 49407 

    end if 

Next i 

Сравнение двух строк на основе этой теме: How to compare two entire rows in a sheet

Пожалуйста вставьте имена вашей рабочей книги, листа и установить диапазон и пределы в коде сам.

Answer 4

Я думаю, что самый быстрый/лучший будет зависеть от доли дубликатов - только одна строка должна быть быстрее 50%, как в примере, - и от фактического размера массива (сколько столбцов, из которых можно создать ключ, и т.д).

Учитывая, что редко можно бить встроенные функции с помощью «чистого» VBA, я подозреваю, что с помощью пользовательского интерфейса, в случае необходимости, VBA будет быстрее в некоторых случаях.Например:

Добавить столбец с индексом (заполнить серийный номер), скопировать весь лист (скажем в Sheet2), применить Удалить дубликаты для всех, кроме столбца индекса, а затем применить в качестве правила формулы CF такого типа соответствующий диапазон оригинала лист:

=$A1=MATCH($A1,Sheet2!$A$1:$A$3000,0)>0 

---

Предполагая, что начальная точка находится примерно так:

и Columna вставляется с цифровой заливки серии начиная 1, Лист2 должен выглядеть так после Удалить Дубликаты:

я предположил, что ColumnE будет проигнорирована, насколько тиражирование обеспокоен.

В исходном листе выберите массив (от A1: - see!), Например A1: I6 и HOME> Стили - Условное форматирование, Новое правило ..., Используйте формулу, чтобы определить, какие клетки форматировать, Формат значения, где эта формула верна::

=$A1=MATCH($A1,Sheet2!$A:$A,0)>0 

Формат ..., заполняющая, серый, OK, OK.

Для меня приводит: