Удаление повторов

[VohA]

Вопрос у меня простой, и как-то давно здесь рассматривался, но в поиске я этой темы не нашёл, так что буду пытать вас. Нужно удалять строку, если число в певой колонке повторяется. Я написал код, но он удаляет только повторы следующие друг за другом:
Dim J, I As Integer
J = 1
Do Until IsEmpty(Cells(J, 1))
For I = 2 To 5000
If Sheets(1).Cells(I, 1).Value = Sheets(1).Cells(J, 1) Then Rows(I).Delete
J = J + 1
Next I
Loop
Помогите плз

[Sebas]

делай в убывающем порядке

и не пересекай

[VohA]

Про обратный порядок- понял, а вот про "не пересекай"- если можно поподробнее.

[VohA]

Попробовал в обратном (For i=5000 to 2), он у меня вообще из цикла не смог выйти,
Распишите пожалуйста поподробнее (очень надо).

[Ernis]

Privet

Mozet tak pomozet

Dim J, I As Integer
J = 1
I = 2
Do Until IsEmpty(Cells(J, 1))
Do Until IsEmpty(Cells(I, 1))
If Sheets(1).Cells(I, 1).Value = Sheets(1).Cells(J, 1) Then Rows(I).Delete
I = I + 1
Loop
J = J + 1
I = J + 1
Loop

Jesly ja xorosho vas ponial?

Dobrovo dnia

[VohA]

2Ernis: не работает, прискорбно.
Господа, посоветуйте ещё чонидь, ГОРЮ, может использовать search или find
HELP

[Sebas]

For i=5000 to 2 Step -1
For y=i-1 to 1 step -1

[Ernis]

Tak aha tam bylo mnoju nedadumano

tak mozet tak:

Public Sub rrr()
Dim J, I As Integer
J = 1
I = 2
Do Until IsEmpty(Cells(J, 1))
Do Until IsEmpty(Cells(I, 1))
If Sheets(1).Cells(I, 1).Value = Sheets(1).Cells(J, 1) Then
'd = J
Rows(I).Delete
I = I - 1
End If
I = I + 1
Loop
'If d <> emty Then
'Rows(J).Delete
'I = J + 1
'd = Empty
'Else
J = J + 1
I = J + 1
'd = Empty
'End If
Loop
End Sub

Esli uberiosh remarki to takda udalyt vsio daze tu stroku skem ty sravnival. A tak to udalyt tolko vse zanim posledujeshyje stroki i astaviat pervoju stroku skem ty sravnival.

[GSerg]

Код: Выделить всё

Sub sdfhs()
  Dim i As Long
 
  With Range("j1")
    .CurrentRegion.Sort .Cells(1)
    For i = .CurrentRegion.Rows.Count To 2 Step -1
      If Cells(i, 10).Value = Cells(i - 1, 10).Value Then Rows(i).Delete
    Next
  End With
End Sub