Как проверить повторение чисел в столбце

[Hugo121]

Сообщение от zenner

В этом файле Вложение 45765 один номер повторяется два раза в двух разных местах.Как бы его найти? Спасибо!!!

Там номер 795604 повторяется 3 раза. Вот для поиска этих повторений и нужен макрос а тот код что выше, не находит их!

Я настаиваю, что 795604 повторяется один раз (т.е. оригинал и одно повторение).
И код прекрасно находит его и ещё вероятно пару сотен повторений... Можно подсчитать...
Подсчитал - 1910 повторов разных значений.
Вот и говорю, что каша.

[doober]

Поддерживаю Hugo121 ,повторов нет,тем более телефона 795604
вообще в файле нет

[Hugo121]

Есть Nr.tel 795604
Вообще задание было такое:
"а подскажите пожалуйста макрос который будет искать на всем листе,во всех ячейках все повторы и будет выделять оригинал красным а повторы зеленым цветом"
Я именно так и сделал. И не надо говорить, что макрос не работает.

[IgorGO]

формула (формула массива)

="повторений: " & СЧЁТЗ(дано)-СУММ(1/СЧЁТЕСЛИ(дано;дано)) & " шт."

покажет сколько повторений образовалось.
где
дано - ссылка на диапазон с данными (в примере они в колонке А)

[zenner]

А подскажите пожалуйста как указать макросу чтобы он искал повторения только в колонках K, L, M, N ?

[Hugo121]

        For Each cc In Intersect(ActiveSheet.UsedRange, Range("k:n"))

[zenner]

Сообщение от Hugo121

        For Each cc In Intersect(ActiveSheet.UsedRange, Range("k:n"))

Спасибо!!!

[Slavatron1984]

По моему отличный макрос, из архива http://programmersforum


Sub Main()
Dim x As Range, y As New Collection, i As Long, j As Integer, k As Integer, a()
With Application
.FindFormat.Clear: .ReplaceFormat.Clear: .ScreenUpdating = False
With ActiveSheet.UsedRange
.Replace "0", "", xlWhole: .Replace "00", "", xlWhole
For i = .Rows.Count To 2 Step -1
If Rows(i).Text = "" Then Else Exit For
Next
End With
Set x = Range([A2], Cells(i - 1, 20)): a = x.Value: k = 2
x.NumberFormat = "@": x.Interior.ColorIndex = xlNone
For i = 1 To UBound(a, 1)
For j = 1 To UBound(a, 2)
If a(i, j) <> "" Then
On Error Resume Next
y.Add a(i, j), CStr(a(i, j))
If Err <> 0 Then
k = IIf(k > 18, 3, k + 1): .ReplaceFormat.Interior.ColorIndex = k
.[A:T].Replace a(i, j), a(i, j), xlWhole, , , , , True: On Error GoTo 0
End If: End If: Next: Next: End With
End Sub