删除行 VBA 宏需要大量时间

Question

我有一个宏，它根据列中的某个值删除行，然后对它们进行排序。它工作正常。但是，工作表从大约 4000 行开始，宏最终删除了其中的大约 2000 行，这需要 1 分 25 秒才能完成。我想知道是否有什么我可以做的事情会减少很多时间。这是代码：

'remove numbers that are not allowed based on values in "LimitedElements" worksheet

For i = imax To 1 Step -1
    a = Sheets("FatigueResults").Cells(i, 1).Value
    Set b = Sheets("LimitedElements").Range("A:A")
    Set c = b.Find(What:=a, LookIn:=xlValues)

    If Not c Is Nothing Then
        Sheets("FatigueResults").Rows(i).EntireRow.Delete
    End If
Next i

'delete unecessary or redundant rows and columns
Rows(3).EntireRow.Delete
Rows(1).EntireRow.Delete
Columns(23).EntireColumn.Delete
Columns(22).EntireColumn.Delete
Columns(21).EntireColumn.Delete
Columns(20).EntireColumn.Delete
Columns(14).EntireColumn.Delete
Columns(13).EntireColumn.Delete
Columns(12).EntireColumn.Delete
Columns(11).EntireColumn.Delete
Columns(4).EntireColumn.Delete
Columns(3).EntireColumn.Delete
Columns(2).EntireColumn.Delete

'sort data
    Dim strDataRange As Range
    Dim keyRange As Range

    Set strDataRange = Range("A:Q")
    Set keyRange1 = Range("B1")
    Set keyRange2 = Range("G1")
    strDataRange.sort Key1:=keyRange1, Order1:=xlDescending,     Key2:=keyRange2, Order2:=xlDescending, Header:=xlYes

'delete rows that are not in the included values    For i = imax To 2 Step -1

    If (Cells(i, 2).Value <> 0.04 And Cells(i, 2).Value <> 0.045 And Cells(i, 2).Value <> 0.05 And Cells(i, 2).Value <> 0.056 And Cells(i, 2).Value <> 0.063 And Cells(i, 2).Value <> 0.071 And Cells(i, 2).Value <> 0.08 And Cells(i, 2).Value <> 0.09 Or Cells(i, 3).Value <= 0) Then

        ActiveSheet.Rows(i).EntireRow.Delete

    End If

Next i

Answer 1

在开头添加：

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

在最后添加：

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

此外，而不是

If (Cells(i, 2).Value <> 0.04 And Cells(i, 2).Value <> 0.045 And Cells(i, 2).Value <> 0.05 And Cells(i, 2).Value <> 0.056 And Cells(i, 2).Value <> 0.063 And Cells(i, 2).Value <> 0.071 And Cells(i, 2).Value <> 0.08 And Cells(i, 2).Value <> 0.09 Or Cells(i, 3).Value <= 0) Then

    ActiveSheet.Rows(i).EntireRow.Delete

End If

使用

Select Case Cells(i, 2)
Case 0.4, 0.045, 0.05, 0.056, 0.063, 0.071, 0.08, 0.09, Is < 0
    'Do nothing
Case Else
    ActiveSheet.Rows(i).EntireRow.Delete
End Select

Answer 2

我更喜欢构建一串要删除的行，然后执行一次删除。这是我昨天在这里为另一个 post 整理的示例：

Sub DeleteRows()
Dim i As Long, DelRange As String
For i = 1 To Cells(Rows.Count, 6).End(xlUp).Row 'Doesn't matter which way you go when you delete in one go
    If Left(Cells(i, 6), 3) = "314" Then DelRange = DelRange & "," & i & ":" & i 'Change the "314" as you see fit
Next i
Range(Right(DelRange, Len(DelRange) - 1)).Delete
End Sub

也无需担心只执行一次删除时关闭计算或屏幕更新等

删除行 VBA 宏需要大量时间

Delete lines VBA macro takes a significant amount of time

excel

time

vba

lines