как изменить макрос... Надо найти дубликаты и в соседней ячейке написать комментарий
Тут не дорабатывать надо, а менять подход. Сначала залить условным форматированием, потом пытаться по этому форматированию определить дубли...
Проще. По значениям ходим... и находим :)
Работа с объектами листа медленная, поэтому обрабатывать лучше в памяти.
Проверяем значения столбца D. В столбец E записываем номера строк найденных дублей.
Sub Tst()
Dim Ar()
Dim lRws As Long
Dim i As Long, k As Long
With ActiveSheet
lRws = .Cells(.Rows.Count, 4).End(xlUp).Row ' последняя заполненная ячейка
Ar = .Range("D1:D" & lRws).Value ' значения в массив
ReDim Preserve Ar(1 To lRws, 1 To 2) ' расширяем размерность для комментариев
For i = 1 To lRws - 1 ' цикл по проверяемым значениям
If Ar(i, 1) <> Empty Then ' значение есть
For k = i + 1 To lRws ' цикл по сравниваемым значениям
If Ar(i, 1) = Ar(k, 1) Then ' нашли дубль
' записываем комментарий - номера строк с дублями
Ar(i, 2) = Ar(i, 2) & "/" & k
Ar(k, 2) = Ar(k, 2) & "/" & i
End If
Next k
End If
Next i
.Range("D1:E" & lRws).Value = Ar ' выгрузка на лист
End With
End Sub
Код ниже отметит повторы значений:
Sub SearchOfTakes()
Dim rRng As Range, c As Range
Dim oDict As Object
Dim lRws As Long
With ActiveSheet
lRws = .Cells(.Rows.Count, 4).End(xlUp).Row ' последняя заполненная ячейка
Set rRng = .Range("D1:D" & lRws) ' диапазон в переменную
Set oDict = CreateObject("scripting.dictionary") ' словарь
For Each c In rRng ' цикл по ячейкам диапазона
If c.Value <> "" Then ' значение есть
If oDict.exists(c.Value) Then ' если значение было раньше
c.Offset(, 1) = "дубль" ' отмечаем его
Else ' значение первый раз в диапазоне
Set oDict(c.Value) = c ' в словарь
End If
End If
Next c
End With
End Sub