如何使用VBA根据标准删除Excel中的行？

Question

我目前正在构建一个宏来格式化一张数据，以及删除不适用的数据行。具体来说，我正在寻找删除列L =“ABC”的行，以及删除列AA“012”的行。

到目前为止，我已经能够实现第一个目标，但不是第二个目标。现有的代码是：

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 

Answer 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 

Answer 2

使用环：

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 

使用自动筛选（未经测试 - 可能更快）：

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 

Answer 3

Sub test() 

    Dim bUnion As Boolean 
    Dim i As Long, lastrow As Long 
    Dim r1 As Range 
    Dim v1 As Variant 

    lastrow = Cells(Rows.Count, 1).End(xlUp).Row 
    v1 = ActiveSheet.Range(Cells(1, 12), Cells(lastrow, 27)).Value2 
    bUnion = False 

    For i = 1 To lastrow 
     If v1(i, 1) = "ABC" Or v1(i, 16) <> "DEF" Then 
      If bUnion Then 
       Set r1 = Union(r1, Cells(i, 1)) 
      Else 
       Set r1 = Cells(i, 1) 
       bUnion = True 
      End If 
     End If 
    Next i 
    r1.EntireRow.Delete 

End Sub 

Answer 4

它通常是快得多使用自动筛选而不是环路范围

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

工作列将公式

=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