[英]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.