为什么我的代码不起作用？不返回错误，但不会从D1列中删除值。我需要根据条件删除行n

Question

为什么我的代码不起作用？不返回错误，但不会从D1列中删除值。我需要根据条件删除行。

Dim i1 As Long

i1 = 1

Do While i1 <= ThisWorkbook.ActiveSheet.Range("D1").CurrentRegion.Rows.Count

    If InStr(1, ThisWorkbook.ActiveSheet.Cells(i1, 1).Text, "бочка", vbTextCompare) > 0 Then
        ThisWorkbook.ActiveSheet.Cells(i1, 1).EntireRow.Delete
         ElseIf InStr(1, ThisWorkbook.ActiveSheet.Cells(i, 1).Text, "(Б/У)", vbTextCompare) > 0 Then
        ThisWorkbook.ActiveSheet.Cells(i1, 1).EntireRow.Delete
          ElseIf InStr(1, ThisWorkbook.ActiveSheet.Cells(i, 1).Text, " БУ ", vbTextCompare) > 0 Then
        ThisWorkbook.ActiveSheet.Cells(i1, 1).EntireRow.Delete
    Else
        i1 = i1 + 1
    End If

Loop


End Sub

Answer 1

删除行需要在范围内向后循环，因为在向前循环中删除行时，所有内容都会上移，因此数据将被跳过。另外，执行一条remove语句将加快代码执行速度。

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

        Do While i1 <= .Range("D1").CurrentRegion.Rows.Count

            Select Case True

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

                    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

        Loop

    End With

    remove.EntireRow.Delete

End Sub