减lessmacros观时间

过去几天我一直在使用VBA代码，一切似乎一直很好，直到我把下面的代码添加到这一天。 马可的执行时间增加到了我自己不会完成的时候。 我已经等待了将近2个小时，但它仍在继续运行。

这个数据表大小约为15 MB，包含大约47,000行，25列填充数据。 我已经运行这个代码来删除行的基础列上的多个条件“H”。

这是代码。 任何帮助减less运行时间高度赞赏。

谢谢…

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

删除行（逐行）很慢，请尝试使用联合并删除所有行一次。

 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 

Answer 2

Or不会短路，所以每个Likeexpression式都会被执行，在第一个匹配中停止的另一种方法（您实际上并不需要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 

如果任何值为空或者存在一个大的非常量不匹配的值，则应该先检查并排除它们。

Answer 3

您可以构build一组嵌套的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 

在这样做之后，另一个优化级别是从最普遍到最不重要的顺序排列“if”语句，从而减less预期的比较次数。