VBA. Скрипт не работает как надо.

Question

VBA. Скрипт не работает как надо.

Богорог Всемогущий Мыслитель (7190), закрыт 5 лет назад

Короче. В столбце текстовые значения. Мне нужно, чтобы этот молодой брал значения по порядку, проверял все остальные и удалял все повторяющиеся. Потом переходил к следующему значению, и удалял уже его повторы и так далее.

Вот код:

Sub test()
Dim clearing As Integer
Dim PosStr As Long
Dim i As Integer
Dim iString As Variant
Dim cond As Variant
clearing = 2
Range("G2").Select
PosStr = ActiveSheet.UsedRange.Rows.Count
MsgBox (PosStr)
For clearing = 2 To PosStr
Range("G" & clearing).Select
iString = ActiveCell.Value

Do
cond = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value = iString Then
Selection.EntireRow.Delete
End If
Loop While Not cond < 1
clearing = clearing + 1
Next clearing

MsgBox (PosStr)
MsgBox (clearing)
MsgBox "All done beach"
End Sub

MsgBox'ы, это я так, для себя сделал, чтобы отслеживать как работают счётчики.

Так вот. Он удаляет не все повторы, а я уже 2 дня насилую себе мозг, пробую разное и не могу понять почему. Хотя если выделить повторяющиеся значения условным форматированием, то они есть. Что означает, что там нет каких-то косяков в раскладке при записи ячеек или чего-то подобного.

Где я не прав? Подскажите, во имя всего сущего.

Прилагаю скриншот для тех, кому так легче воспринимать.

Дополнен 5 лет назад

Актуально.

Дополнен 5 лет назад

решено

Answer 1

Не совсем понял, зачем вы вмешиваетесь в работу цикла и изменяете значение управляющей переменной?

clearing = clearing + 1

После прохода цикла со значением clearing = 2, эта строчка увеличит clearing до 3, а потом еще и механизм цикла повторит это действие и в результате clearing станет равным 4

Answer 2

В Идеале переделать всю логику :)
но что бы заработало можно вставить вот такую строку

Sub test()
Dim clearing As Integer
Dim PosStr As Long
Dim i As Integer
Dim iString As Variant
Dim cond As Variant
clearing = 2
Range("G2").Select
PosStr = ActiveSheet.UsedRange.Rows.Count
MsgBox (PosStr)

For clearing = 2 To PosStr
Range("G" & clearing).Select
iString = ActiveCell.Value

Do
cond = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value = iString Then
Selection.EntireRow.Delete

If clearing > 0 And ActiveCell.Value <> "" Then clearing = clearing - 2

End If
Loop While Not cond < 1
clearing = clearing + 1

DoEvents 'Ïàóçà ÷òî áû íåçàâèñàëî

Next clearing

MsgBox (PosStr)
MsgBox (clearing)
MsgBox "All done beach"
End Sub