如何使用VBA基于条件删除Excel中的行?

Lau*_*yon 10 excel vba excel-vba

我目前正在构建一个宏来格式化一张数据以及删除不适用的数据行.具体来说,我希望删除列L ="ABC"的行,以及删除列AA <>"DEF"的行.

到目前为止,我已经能够实现第一个目标,但不是第二个目标.现有代码是:

Dim LastRow As Integer
Dim x, y, z As Integer
Dim StartRow, StopRow As Integer

For x = 0 To LastRow
    If (Range("L1").Offset(x, 0) = "ABC") Then
    Range("L1").Offset(x, 0).EntireRow.Delete
    x = x - 1

End If
Run Code Online (Sandbox Code Playgroud)

bre*_*tdj 11

使用AutoFilter而不是循环范围通常要快得多

下面的代码创建一个工作列,然后使用公式检测删除条件,然后自动筛选并删除结果记录

工作栏提出了一个公式

=OR(L1="ABC",AA1<>"DEF") 进入第一个空白列的第1行,然后向下复制到真正使用的范围.然后使用AutoFilter快速删除任何TRUE记录

Sub QuickKill()
    Dim rng1 As Range, rng2 As Range, rng3 As Range
    Set rng1 = Cells.Find("*", , xlValues, , xlByColumns, xlPrevious)
    Set rng2 = Cells.Find("*", , xlValues, , xlByRows, xlPrevious)
    Set rng3 = Range(Cells(rng2.Row, rng1.Column), Cells(1, rng1.Column))
    Application.ScreenUpdating = False
    Rows(1).Insert
    With rng3.Offset(-1, 1).Resize(rng3.Rows.Count + 1, 1)
        .FormulaR1C1 = "=OR(RC12=""ABC"",RC27<>""DEF"")"
        .AutoFilter Field:=1, Criteria1:="TRUE"
        .EntireRow.Delete
        On Error Resume Next
        'in case all rows have been deleted
        .EntireColumn.Delete
        On Error GoTo 0
    End With
    Application.ScreenUpdating = True
End Sub
Run Code Online (Sandbox Code Playgroud)


Pat*_*rez 8

使用循环:

Sub test()
    Dim x As Long, lastrow As Long
    lastrow = Cells(Rows.Count, 1).End(xlUp).Row
    For x = lastrow To 1 Step -1
        If Cells(x, 12).Value = "ABC" or Cells(x, 27) <> "DEF" Then
            Rows(x).Delete
        End If
    Next x
End Sub
Run Code Online (Sandbox Code Playgroud)

使用自动过滤器(未经测试 - 可能更快):

Sub test2()
    Range("a1").AutoFilter Field:=12, Criteria1:="ABC", Operator:=xlOr, _
                           Field:=28, Criteria1:="<>""DEF"""
    'exclude 1st row (titles)
    With Intersect(Range("a1").CurrentRegion, _
                   Range("2:60000")).SpecialCells(xlCellTypeVisible)
        .Rows.Delete
    End With
    ActiveSheet.ShowAllData
End Sub
Run Code Online (Sandbox Code Playgroud)

  • 如果您不想删除第一行(如果您有标题),请将"For x = lastRow To 1 Step -1"更改为"For x = lastRow To 2 Step -1" (3认同)

Met*_*ler 1

编号 12 的单元格为“L”,编号 27 的单元格为“AA”

Dim x As Integer

x = 1

Do While x <= ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row

    If (Cells(x, 12) = "ABC") Then
    ActiveSheet.Rows(x).Delete
    Else
        If (Cells(x, 27) <> "DEF") And (Cells(x, 27) <> "") Then
        ActiveSheet.Rows(x).Delete
        Else
        x = x + 1
        End If
    End If

Loop

End Sub
Run Code Online (Sandbox Code Playgroud)