删除行VBA宏需要大量时间 [英] Delete lines VBA macro takes a significant amount of time

问题描述

我有一个宏，该宏根据列中的某个值删除行，然后对它们进行排序.它工作正常.但是，工作表从大约4000行开始，宏最终删除了大约2000行，并且需要1分25秒来完成.我想知道是否有什么我可以做的，这将使它花费更少的时间.这是代码:

I have a macro that deletes lines based on a certain value in a column and then sorts them. It works fine. However, the worksheet starts with about 4000 rows and the macro ends up deleting about 2000 of them and it takes 1 minute 25 seconds to do it. I'm wondering if there's something I can do that will make it take a lot less time. Here's the code:

'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

推荐答案

在开头添加此内容:

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

这篇关于删除行VBA宏需要大量时间的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！