Excel VBA替代高级过滤/提高处理时间

目标是让这个代码更有效地运行。 我相信主要的问题是filter。 这个数据有32,000多行。 另一个有60万行以上的标签则更糟。 计算是需要的，因为数据被带到另一个选项卡，然后返回一次计算（sorting然后按顺序）。 任何想法都表示赞赏。

Sub TestMacro() Application.ScreenUpdating = False Application.DisplayStatusBar = False Application.Calculation = xlManual ActiveSheet.DisplayPageBreaks = False Range("SubtotalRngClear").ClearContents On Error Resume Next Range("FilterArea").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _ Range("Criteria"), Unique:=False On Error Resume Next Range("SubtotalRngClear").SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=SUBTOTAL(3,R10C2:RC[1])" Worksheets("RETS").Calculate If Not Application.CalculationState = xlDone Then DoEvents End If Worksheets("Spreadsheet").Calculate If Not Application.CalculationState = xlDone Then DoEvents End If Range("AdjRng").SpecialCells(xlCellTypeVisible).Formula = "=INDEX(Spreadsheet!$C$8:$BJ$27,20,(MATCH(INDIRECT(ADDRESS(ROW(),1)),Spreadsheet!$C$8:$BI$8)+1))" Range("FilterArea").Select Range("V9").Activate ActiveWorkbook.Worksheets("RETS").Sort.SortFields.Clear ActiveWorkbook.Worksheets("RETS").Sort.SortFields.Add Key:=Range("AdjRng" _ ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("RETS").Sort .SetRange Range("FilterRangeWHeaders") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Worksheets("RETS").Calculate If Not Application.CalculationState = xlDone Then DoEvents End If Worksheets("Spreadsheet").Calculate If Not Application.CalculationState = xlDone Then DoEvents End If Application.Calculation = xlAutomatic Application.ScreenUpdating = True Application.DisplayStatusBar = True ActiveSheet.DisplayPageBreaks = True End Sub 

Answer 1

如果我没弄错的话

 Application.Calculation = xlAutomatic 

从手动切换到自动时立即重新计算所有内容。 因此，您可以消除最后两个“.Calculate”语句。 您也可以尝试在您的makro开始时禁用事件，并使用以下命令启用它们：

 Application.EnableEvents = False <...your code...> Application.EnableEvents = True 

为了进一步解决速度问题，您可以通过使用“F8”键逐步完成代码。 由此你应该看到最慢的操作。