VBA：使简单的macros运行更快

我需要search两个表，每天更改某些值 ，然后突出显示相应的单元格灰色，并在每个表的第一列中写入阈值。

为此，我正在使用以下方法，按预期工作。
不幸的是，这个macros需要一分多钟才能完成，对我来说这似乎很漫长（而这个macros只是一个较大macros的一部分）。

这两个表都比较小，只包含约。 500人 100条logging。

有人可以告诉我如何使这个运行更快，或写这个代码更有效率 ？

我的代码：

Sub PrepareRankRecords(varMode As String) Call RankRecords(varMode, 10000) Call RankRecords(varMode, 5000) Call RankRecords(varMode, 2000) Call RankRecords(varMode, 1500) Call RankRecords(varMode, 1000) Call RankRecords(varMode, 500) End Sub Sub RankRecords(varMode As String, varRank As Integer) Dim cell As Range, varRange As Range If varMode = "DSP" Then ' table AE:AJ Application.StatusBar = "90 % - Ranking table AE:AJ" DoEvents Set varRange = Range("$AI$3", Cells(Rows.Count, "AI").End(xlUp)).Cells Else ' table X:AC Application.StatusBar = "60 % - Ranking table X:AC" DoEvents Set varRange = Range("$AB$3", Cells(Rows.Count, "AB").End(xlUp)).Cells End If With Worksheets(4) For Each cell In varRange If cell.Offset(0, -3).Value <> "" Then If cell.Value < varRank Then cell.Offset(0, -4).Value = "< " & Format(varRank, "#,##0") .Range(Cells(cell.Row, cell.Column - 4), Cells(cell.Row, cell.Column + 1)). _ Interior.Color = RGB(217, 217, 217) .Range(Cells(cell.Row, cell.Column - 4), Cells(cell.Row, cell.Column + 1)). _ Font.Bold = True Exit For End If Else Exit For End If Next End With End Sub 

非常感谢提供任何帮助，迈克

Answer 1

通常我会做的是以下几点：

 Sub PrepareRankRecords(varMode As String) call Onstart Call RankRecords(varMode, 10000) Call RankRecords(varMode, 5000) 'other code call OnEnd End Sub Public Sub OnEnd() Application.ScreenUpdating = True Application.EnableEvents = True Application.AskToUpdateLinks = True Application.DisplayAlerts = True Application.Calculation = xlAutomatic ThisWorkbook.Date1904 = False Application.StatusBar = False End Sub Public Sub OnStart() Application.ScreenUpdating = False Application.EnableEvents = False Application.AskToUpdateLinks = False Application.DisplayAlerts = False Application.Calculation = xlAutomatic ThisWorkbook.Date1904 = False ActiveWindow.View = xlNormalView End Sub 

您可以检查OnStart / OnEnd并删除您认为无用的部分。

Answer 2

我会用Cells(cell.Row, cell.Column - 4) cell(1, -3)replaceCells(cell.Row, cell.Column - 4) cell(1, -3) 。

此外，我会取代连续调用RankRecords与使用Select Case在您的主循环，一次完成所有的事情。