如果列值=“”，VBA快速查找和删除行[重复]

Question

我创建了一个宏来生成每日报告。但是，它需要很长时间才能运行。在 AN 列中查找值并删除整行的宏部分需要小步舞曲才能运行。

以下示例删除 AN 列中所有不包含值“CAT”的行。

有没有更有效的方法来编写代码，这样它就不会花很长时间运行？可能还为其他值添加一个数组？ （猫、狗、牛） 谢谢！

代码效率低下（工作，但由于数百行而运行时间很长）：

'False screen updating
Application.ScreenUpdating = False
'deleting all other types other than CAT from "samples" tab (excluding the header row, row 1)
Sheets("sample").Select
LastRowNum = Cells.SpecialCells(xlCellTypeLastCell).Row
ReadRow = 2
For n = 2 To LastRowNum
    If Range("AN" & ReadRow).Value <> "CAT" Then
    Range("AN" & ReadRow).EntireRow.Delete
Else
  ReadRow = ReadRow + 1
End If

Answer 1

使用联合并删除一次：

With Worksheets("sample")
    Dim LastRowNum As Long
    LastRowNum = .Cells(.Rows.Count, "AN").End(xlUp).Row


    Dim rng As Range

    Dim n As Long
    For n = 2 To LastRowNum
        If .Range("AN" & n).Value <> "CAT" Then
            If rng Is Nothing Then
                Set rng = .Rows(n)
            Else
                Set rng = Union(rng, .Rows(n))
            End If
        End If
    Next n

    rng.EntireRow.Delete
End With

Answer 2

这是一种删除空白行的方法，应该相当快。

Public Sub RemoveBlankRows(ws As Worksheet)
On Error GoTo errorHandler:

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim LastRow As Long
    LastRow = ws.Cells.Find(What:="*", After:=ws.Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row

    For i = LastRow To 1 Step -1
        If WorksheetFunction.CountA(ws.Cells(i, 1).EntireRow) = 0 Then ws.Rows(i).Delete Shift:=xlShiftUp
    Next

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    Exit Sub

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

Sub ExampleUsage()
     RemoveBlankRows ThisWorkbook.Sheets("Sheet1")
End Sub