清理录制的 Excel 宏中的代码答案

【问题标题】：Cleaning up code in recorded Excel Macro清理录制的 Excel 宏中的代码
【发布时间】：2016-03-02 16:07:45
【问题描述】：

我使用 Record Macro 功能来创建它，但它运行得非常慢，我想看看是否有人对如何清理它有任何想法。看起来好像我有两种在这里做同样的事情？提前致谢。

Sub Activations()
'
' Master_Button2_2_Click Macro
'

'
Application.ScreenUpdating = False
Sheets("Index").Select
Columns("A:C").Select
ActiveWorkbook.Worksheets("Index").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Index").Sort.SortFields.Add Key:=Range("B2:B12000" _
    ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Index").Sort
    .SetRange Range("A1:C12000")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Sheets("Duplicates").Select
ActiveSheet.Range("$L$4:$N$3476").AutoFilter Field:=1, Criteria1:= _
    "Activate"
Sheets("Master").Select
ActiveSheet.Range("$A$2:$BU$11965").AutoFilter Field:=73, Criteria1:= _
    "A"
Application.ScreenUpdating = True
End Sub

【问题讨论】：

标签： excel vba macros

【解决方案1】：

您的代码相当简单，尽管它要完成的工作并不完全清楚。这是一个快速重写，添加了几个 With ... End With statement 用于缩小受影响的工作区域。

Sub Activations()
    ' Master_Button2_2_Click Macro
    Dim lr As Long

    appTGGL bTGGL:=False

    With Worksheets("Index")
        lr = .Cells.SpecialCells(xlCellTypeLastCell).Row
        With .Range("A1:C" & lr)
        .Cells.Sort Key1:=.Columns(2), Order1:=xlAscending, _
                    Orientation:=xlTopToBottom, Header:=xlYes
        End With
    End With

    With Worksheets("Duplicates")
        If .AutoFilterMode Then .AutoFilterMode = False
        lr = .Cells.SpecialCells(xlCellTypeLastCell).Row
        With .Range("L4:N" & lr)
            .AutoFilter Field:=1, Criteria1:="activate"
        End With
    End With

    With Worksheets("Master")
        If .AutoFilterMode Then .AutoFilterMode = False
        lr = .Cells.SpecialCells(xlCellTypeLastCell).Row
        With .Range("A2:BU" & lr)
            .AutoFilter Field:=73, Criteria1:="A"
        End With
        .Select
    End With

    appTGGL
End Sub

Sub appTGGL(Optional bTGGL As Boolean = True)
    With Application
        .EnableEvents = bTGGL
        .ScreenUpdating = bTGGL
        .DisplayAlerts = bTGGL
        .Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual)
    End With
End Sub

样本数据和简短的解释将对这个问题有所帮助。我们不都说英语，但我们都说代码和数据。

【讨论】：