Почему мой код не работает? Не возвращает ошибку, но не удаляет значения из столбца D1. Мне нужно удалить строки на основе критерия

Question

* Почему мой код не работает? Мне нужно удалить строки на основе критериев. у нас есть ошибка при запуске вашего примера ошибка времени выполнения '1004' Ошибка, определяемая приложением или объектом, отметьте эту строку *

            Case .Cells(i1, 1).Text Like "*бочка*", .Cells(i1, 1).Text Like "*(Б/У)*", .Cells(i, 1).Text, " БУ "

Answer 1

Удаление строк требует обратного цикла по диапазону, потому что при удалении строк в прямом цикле все сдвигается вверх, и, таким образом, данные пропускаются. Кроме того, выполнение одного оператора удаления ускорит выполнение кода.

Option Explicit

Sub removeData()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1") '<- change name as needed

    Dim i1 As Long
    i1 = 1

    With ws.Range("D1").CurrentRegion

        Do While i1 <= .Rows.Count

            Select Case True

                Case .Cells(i1, 1).Value Like "*бочка*", .Cells(i1, 1).Value Like "*(Б/У)*", .Cells(i, 1).Value, " БУ "

                    Dim remove As Range
                    If Not remove Is Nothing Then
                        Set remove = Union(remove, .Cells(i1, 1))
                    Else
                        Set remove = .Cells(i1, 1)
                    End If

            End Select

            i1 = 1

        Loop

    End With

    remove.EntireRow.Delete

End Sub