删除行 VBA 宏需要大量时间答案

【问题标题】：Delete lines VBA macro takes a significant amount of time删除行 VBA 宏需要大量时间
【发布时间】：2015-07-15 16:25:11
【问题描述】：

我有一个宏，它根据列中的某个值删除行，然后对它们进行排序。它工作正常。但是，工作表从大约 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

【问题讨论】：

标签： excel time lines vba

【解决方案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

【讨论】：

太好了，谢谢。我忘记了案例功能。我得看看我是否也可以在其他地方使用它。

【解决方案2】：

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

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

当你只执行一次删除时，也不必担心关闭计算或屏幕更新等

【讨论】：