减少宏时间

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

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

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

你可以建立一组嵌套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 

执行此操作后，优化的另一个层面是命令从最普遍到至少“如果”语句，从而减少预期的比较次数。

Answer 3

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 

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