过去几天我一直在使用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
答案 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