Приветствую

появилась необходимость поиска повторяющихся улиц с номерами домов в таблице эксель с помощью макроса

Итак есть столбец "улица", рядом столбец "дом". Есть еще другие Столбцы в которых есть информация.
Если есть 2 записи в которых улица и номер дома идентичны, то подсветить красным цветом чтобы менеджер мог удалить лишнюю запись.
Так как дубликатов быть не должно.
Таблица состоит из 20 000! записей(строк)


Как можно было бы организовать алгоритм обхода так, чтобы это работало максимально производительно(быстро)

прилагаю свой макрос

для тех кому будет интеренсо...то эту задачу решил без макроса..

есть в excel такая фича "условное форматирование".
вот она умеет искать дубликаты. и подсвечивать ячейки.. вообще можно разные формулы задавать. крутая штука.


а вот и макрос..

'для запуска макроса необходимо выделить единственную ячейку: верхняя в столбце списка "улиц"
Sub duplicates()
' =======================
Dim cell, innercell As Object
Dim R, sStartCol, range1, range2 As String
Dim iStartCol, iStartRow, iLastRow, iNextRow As Integer
' =======================

iStartRow = ActiveCell.Row
sStartCol = columnletter(ActiveCell.column)
iLastRow = LastRow(sStartCol)

range1 = sStartCol & iStartRow & ":" & sStartCol & iLastRow
' ===
For Each cell In Range(range1)
R = getTrimCell2(cell.address)
' ==============================
iNextRow = cell.Row + 1
range2 = sStartCol & iNextRow & ":" & sStartCol & iLastRow
' ===
For Each innercell In Range(range2)
'MsgBox innerñell.address
If R = getTrimCell2(innercell.address) Then
Call paint_red(cell)
Call paint_red(innercell)
End If
Next
' ==============================
Next
End Sub

'подсветка ячейки дубликатов красным цветом
Sub paint_red(ByVal cell As Object)
cell.Interior.ColorIndex = 3
End Sub

'функция возвращает конкатенацию ячеек "улица" и "дом" чтобы далее сравнить с другой записью
Function getTrimCell2(adr As String) As String
getTrimCell2 = Trim(Range(adr).Value) & Trim(Range(adr).Offset(0, 1).Value)
End Function

'вычисление последней записи (для организации цикла)
Function LastRow(ByVal columnletter As String) As Integer
LastRow = Range(columnletter & "65536").End(xlUp).Row
'MsgBox ActiveCell.Row
End Function