简体   繁体   English

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

[英]Excel Workbook with VBA macro taking a long time to open

I have written a macro to automate my daily task of filtering a value and then copy in a different sheet.我编写了一个宏来自动执行过滤值的日常任务,然后复制到不同的工作表中。 My Macro is done but when I try to open the excel file it takes longer time to open.我的宏已完成,但是当我尝试打开 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
Set total_data = Sheets("CompetencyView").Range("B15:F1048576")
Set specific_column = Sheets("CompetencyView").Range("E15:E1048576")

I think these lines might be the issue.我认为这些行可能是问题所在。 I think it is what is generating too many rows.我认为这是生成太多行的原因。 Try specifying the range:尝试指定范围:

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

Let me know if that helped.如果这有帮助,请告诉我。

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM