[英]Excel Workbook with VBA macro taking a long 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 = 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))
如果這有幫助,請告訴我。
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.