excel - 减少微距时间

Question

在过去的几天里，我一直在研究 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

Answer 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

如果任何值是空的或存在大量分布的恒定不匹配值，则应首先检查并排除它们。