Set c = Range("D4:D549").Find(101, LookIn:=xlValues)
If Not (c Is Nothing) Then
MsgBox "Нашли: " & c.Address
firstAddress = c.Address
Else
MsgBox "Не нашли"
Exit Sub
End If
Do
c.ClearContents
Set c = Range("D4:D549").FindNext(c)
Loop While Not (c Is Nothing) And c.Address <> firstAddress
Find, FindNext
С толбце D, есть коды и они повторяются, нужно удалить дубликаты.
Код удаляет абсолютно все, что нашли, да еще и выдает ошибку цикла, может легче будет немного подправить его.
Код:
Код:
With Application
Dim iSource As Range
Set iSource = .ThisWorkbook.Worksheets(1).[D4:D549]
'Укажите свою рабочую книгу и рабочий лист
iCount& = .CountIf(iSource, 101)
Select Case iCount&
Case 0: MsgBox "Искомое значение не найдено", , ""
Case 1: MsgBox "В указанном диапазоне нет повторов", , ""
Case Else
.ScreenUpdating = False
.Calculation = xlManual 'И т.д. (по необходимости)
For iCounter& = 1 To iCount& - 1
iSource.Find(101, , xlValues, xlWhole, , xlPrevious).ClearContents
Next
.Calculation = xlAutomatic
.ScreenUpdating = True
End Select
End With
Dim iSource As Range
Set iSource = .ThisWorkbook.Worksheets(1).[D4:D549]
'Укажите свою рабочую книгу и рабочий лист
iCount& = .CountIf(iSource, 101)
Select Case iCount&
Case 0: MsgBox "Искомое значение не найдено", , ""
Case 1: MsgBox "В указанном диапазоне нет повторов", , ""
Case Else
.ScreenUpdating = False
.Calculation = xlManual 'И т.д. (по необходимости)
For iCounter& = 1 To iCount& - 1
iSource.Find(101, , xlValues, xlWhole, , xlPrevious).ClearContents
Next
.Calculation = xlAutomatic
.ScreenUpdating = True
End Select
End With