Excel Workbook с макросом VBA требует много времени для открытия

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))

Дайте мне знать, если это помогло.