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

我目前正在build立一个macros来格式化一张数据，以及删除不适用的数据行。 具体来说，我正在寻找删除列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 

Answer 1

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

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

工作栏中有一个公式

=OR(L1="ABC",AA1<>"DEF")到第一个空列的第一行，然后复制到真实使用的范围。 然后使用AutoFilter快速删除任何TRUElogging

 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 

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 

使用自动filter （未经testing – 可能更快）：

 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

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 4

 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