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

如果列value =“”

2 个答案: