根据不包含名称删除行

Question

Sub Chadsrebate()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

If sheet2.Cells(Rows.Count, 2).Value <>"A","B","C","D" then 
entirerow.delete

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Answer 1

如何实现这一目标的方法之一：

如果要删除包含名称的所有行：

Option Compare Text
Sub Chadsrebate()
    Dim i&, z&
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual

        With Sheets("Sheet2")
            i = .Cells(Rows.Count, "B").End(xlUp).Row
            For z = i To 2 Step -1
                If .Cells(z, "B").Value2 Like "*A*" _
                    Or .Cells(z, "B").Value2 Like "*F*" _
                        Or .Cells(z, "B").Value2 Like "*Z*" _
                            Or .Cells(z, "B").Value2 Like "*Q*" Then
                    .Rows(z).Delete
                End If
            Next z
            z = .Cells(Rows.Count, "B").End(xlUp).Row
        End With

        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
    MsgBox i - z & " Rows has been deleted!"
End Sub

如果要删除所有不包含名称的行：

Option Compare Text
Sub Chadsrebate()
    Dim i&, z&
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual

        With Sheets("Sheet2")
            i = .Cells(Rows.Count, "B").End(xlUp).Row
            For z = i To 2 Step -1
                If Not (.Cells(z, "B").Value2 Like "*A*" _
                    Or .Cells(z, "B").Value2 Like "*F*" _
                        Or .Cells(z, "B").Value2 Like "*Z*" _
                            Or .Cells(z, "B").Value2 Like "*Q*") Then
                    .Rows(z).Delete
                End If
            Next z
            z = .Cells(Rows.Count, "B").End(xlUp).Row
        End With

        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
    MsgBox i - z & " Rows has been deleted!"
End Sub