带有 VBA 宏的 Excel 工作簿需要很长时间才能打开

Question

我编写了一个宏来自动执行过滤值的日常任务，然后将其复制到不同的工作表中。我的宏已完成，但是当我尝试打开 excel 文件时，需要更长的时间才能打开。

Private Sub CommandButton1_Click()

    Dim autofiltrng As Range
    Dim total_data As Range
    Dim specific_column As Range

    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .EnableEvents = False
    End With

    On Error Resume Next

    Sheets("MasterRolePLMap").ShowAllData

    On Error GoTo 0
    'Filter the data as per CompetencyView

    Sheets("MasterRolePLMap").Range("A1").AutoFilter field:=1, Criteria1:=Sheets("CompetencyView").Range("C5").Value

    With Sheets("MasterRolePLMap").AutoFilter.Range
        On Error Resume Next

        'Focus only on visible cells

        Set autofiltrng = .Offset(1, 0).Resize(.Rows.Count - 1, 1).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
    End With

    If autofiltrng Is Nothing Then
        MsgBox "No Data to Copy"

    Else
        Sheets("MasterRolePLMap").Activate

        Sheets("MasterRolePLMap").Range("D:D").Select
        Selection.SpecialCells(xlCellTypeVisible).Select
        Selection.Copy
        Sheets("CompetencyView").Activate
        Sheets("CompetencyView").Cells(14, 2).Select
        Sheets("CompetencyView").Paste

        Sheets("MasterRolePLMap").Activate

        Sheets("MasterRolePLMap").Range("F:F").Select
        Selection.SpecialCells(xlCellTypeVisible).Select
        Selection.Copy
        Sheets("CompetencyView").Activate
        Sheets("CompetencyView").Cells(14, 3).Select
        Sheets("CompetencyView").Paste

        Sheets("MasterRolePLMap").Activate

        Sheets("MasterRolePLMap").Range("E:E").Select
        Selection.SpecialCells(xlCellTypeVisible).Select
        Selection.Copy
        Sheets("CompetencyView").Activate
        Sheets("CompetencyView").Cells(14, 4).Select
        Sheets("CompetencyView").Paste

        Sheets("MasterRolePLMap").Activate

        Sheets("MasterRolePLMap").Range("G:G").Select
        Selection.SpecialCells(xlCellTypeVisible).Select
        Selection.Copy
        Sheets("CompetencyView").Activate
        Sheets("CompetencyView").Cells(14, 5).Select
        Sheets("CompetencyView").Paste

        Sheets("MasterRolePLMap").Activate

        Sheets("MasterRolePLMap").Range("C:C").Select
        Selection.SpecialCells(xlCellTypeVisible).Select
        Selection.Copy
        Sheets("CompetencyView").Activate
        Sheets("CompetencyView").Cells(14, 6).Select
        Sheets("CompetencyView").Paste
    End If

    Sheets("CompetencyView").Activate
    Set total_data = Sheets("CompetencyView").Range("B15:F1048576")
    Set specific_column = Sheets("CompetencyView").Range("E15:E1048576")
    total_data.Sort key1:=specific_column, order1:=xlAscending

    If IsEmpty(Range("B15").Value) = True Then
        With Range(Range("B14"), Range("B14").End(xlToRight)).Borders
            .LineStyle = xlcontinous
            .Weight = xlThin
        End With
    Else
        With Range(Range("B14"), Range("B14").End(xlToRight).End(xlDown)).Borders
            .LineStyle = xlcontinous
            .Weight = xlThin
        End With
    End If

    With Application
        .Calculation = xlCalculationAutomatic

        .ScreenUpdating = True
        .DisplayStatusBar = True
        .EnableEvents = True
    End With

End Sub

Answer 1

Set total_data = Sheets("CompetencyView").Range("B15:F1048576")
Set specific_column = Sheets("CompetencyView").Range("E15:E1048576")

我认为这些线路可能是问题所在。我认为这是生成太多行的原因。尝试指定范围:

i = Sheets("CompetencyView").Cells(rows.count,6).End(xlUp).row
Set total_data = Sheets("CompetencyView").Range(Cells(15,2),Cells(i,6))
i = Sheets("CompetencyView").Cells(rows.count,5).End(xlUp).row
Set specific_column = Sheets("CompetencyView").Range(Cells(15,5),Cells(i,5))

让我知道这是否有帮助。