减少宏观时间

时间:2015-12-18 10:44:13

标签: excel vba

过去几天我一直在使用VBA代码,一切似乎工作正常,直到有一天我将下面的代码添加到它。它马克的执行时间增加到了这样的程度,以至于我自己不会在它完成的时候。我已经等了将近2个小时,但它仍在继续运行。

我所拥有的这个数据表大小约为15 MB,包含大约47,000行,其中25列填充了数据。我已经运行此代码来根据列“H”上的多个条件删除行。

这是代码。任何减少运行时间的帮助都非常受欢迎。

...谢谢

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

Workbooks("Vivar_Template_Blank.xlsx").Sheets("Main & PCO Working").Activate
Dim ws As Worksheet, i&, lastRow&, value$
Set ws = ActiveWorkbook.ActiveSheet
lastRow = ws.Range("H" & ws.Rows.Count).End(xlUp).Row
    For i = lastRow5 To 2 Step -1
    value = ws.Cells(i, 8).value
        If Not (value Like "*Supplier Name*" _
            Or value Like "*[PO]Supplier (Common Supplier)*" _
            Or value Like "*ACCENTURE LLP*" _
            Or value Like "*COGNIZANT TECHNOLOGY SOLUTIONS US CORP*" _
            Or value Like "*INFOSYS LIMITED*" _
            Or value Like "*INFOSYS TECHNOLOGIES LTD*" _
            Or value Like "*INTERNATIONAL BUSINESS MACHINES CORP DBA IBM CORP*" _
            Or value Like "*MINDTREE LIMITED*" _
            Or value Like "*SYNTEL INC*" _
            Or value Like "*TATA AMERICA INTERNATIONAL CORPORATION*") _
            Then
            ws.Rows(i).Delete
        End If
Next

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

3 个答案:

答案 0 :(得分:1)

Or未被短路,因此每个Like表达式都会被执行,这是第一场比赛暂停的替代方法(在这种情况下,您实际上并不需要Like ,您可以使用效率更高的InStr):

Dim lookup(9) As String

lookup(0) = "Supplier Name"
lookup(1) = "[PO]Supplier (Common Supplier)"
lookup(2) = "ACCENTURE LLP"
lookup(3) = "COGNIZANT TECHNOLOGY SOLUTIONS US CORP"
lookup(4) = "INFOSYS LIMITED"
lookup(5) = "INFOSYS TECHNOLOGIES LTD"
lookup(6) = "INTERNATIONAL BUSINESS MACHINES CORP DBA IBM CORP"
lookup(7) = "MINDTREE LIMITED"
lookup(8) = "SYNTEL INC"
lookup(9) = "TATA AMERICA INTERNATIONAL CORPORATION"

For i = lastRow5 To 2 Step -1
    value = ws.Cells(i, 8).value

    For j = 0 To UBound(lookup)
        If InStr(Value, lookup(j)) Then
            ws.Rows(i).Delete
            Exit For
        End If
    Next
Next

如果任何值为空或者存在大量不变的非匹配值,则应首先检查并排除它们。

答案 1 :(得分:0)

您可以构建一组嵌套的if / else结构,以便在遇到第一个真实条件时终止逻辑。

    If Not (value Like "*Supplier Name*") then
        ws.Rows(i).Delete
    else if value Like "*[PO]Supplier (Common Supplier)*" then
            ws.Rows(i).Delete
    else if ...


    End If

执行此操作后,另一个优化级别是订购'如果'从最普遍到最不重要的陈述,从而减少了预期的比较次数。

答案 2 :(得分:0)

删除行(逐行)很慢,尝试使用Union并删除所有行一次。

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

Workbooks("Vivar_Template_Blank.xlsx").Sheets("Main & PCO Working").Activate
Dim ws As Worksheet, i&, lastRow&, value$
Dim uRng As Range

Set ws = ActiveWorkbook.ActiveSheet
lastRow = ws.Range("H" & ws.Rows.Count).End(xlUp).Row
    For i = lastRow5 To 2 Step -1 ' !!! maybe lastRow not lastRow5 because there is no value for lastRow5 in your code!!!
    value = ws.Cells(i, 8).value
        If Not (value Like "*Supplier Name*" _
            Or value Like "*[PO]Supplier (Common Supplier)*" _
            Or value Like "*ACCENTURE LLP*" _
            Or value Like "*COGNIZANT TECHNOLOGY SOLUTIONS US CORP*" _
            Or value Like "*INFOSYS LIMITED*" _
            Or value Like "*INFOSYS TECHNOLOGIES LTD*" _
            Or value Like "*INTERNATIONAL BUSINESS MACHINES CORP DBA IBM CORP*" _
            Or value Like "*MINDTREE LIMITED*" _
            Or value Like "*SYNTEL INC*" _
            Or value Like "*TATA AMERICA INTERNATIONAL CORPORATION*") _
        Then
            'ws.Rows(i).Delete
              If uRng Is Nothing Then
                Set uRng = ws.Rows(i)
              Else
                Set uRng = Union(uRng, ws.Rows(i))
              End If

        End If
Next

 If Not uRng Is Nothing Then uRng.Delete

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