清理录制的Excel宏中的代码

时间:2016-03-02 16:07:45

标签: excel vba macros

我使用了录制宏功能来创建它,但它运行速度很慢,我想知道是否有人对如何清理它有任何想法。看起来我在这里有两种做同样的事情吗?提前谢谢。

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

1 个答案:

答案 0 :(得分:0)

您的代码相当简单,但并不完全清楚它的目标是什么。这是一个快速重写,将几个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

样本数据和简短的解释说明可以帮助解决这个问题。我们不会说英语,但我们都会说代码和数据。