优化VBA代码并提高性能 [英] Optimizing the VBA Code and improve the performance
问题描述
我已经开发了一个VBA宏,该宏用于刷新5个SAP AAO查询,然后通过删除重复项将那些查询数据正确地复制到表中,然后再加载到超级查询中.在那里,我添加了一些计算出的列,然后将这些数据加载到功率支点中.
I have developed a VBA macro which is used to refresh the 5 SAP AAO Queries and then copy those queries data into tables saperately by removing duplicates and then loaded into the power query. There i add some calculated columns and then load that data into the power pivots.
我还使用了下面提到的VBA代码在每个工作表中执行一些操作,但是运行该代码目前需要4分钟以上的时间.
I have also used the VBA code mentioned below to perform some actions in each of the sheets, however it is currently taking more than 4 minutes to run the code.
在这4分钟内,至少需要45秒来刷新AAO查询,而剩余时间(包括刷新功率查询)需要花费运行时间
In that 4 minutes at least 45 seconds are going for refreshing the AAO queries and the remaining time macro is taking to run (including refreshing power queries)
我仍在学习VBA,因此我在代码中使用了宏记录器代码以及 select/activate
表.我知道这不是正确的方法,因为除此以外我不知道更好的选择.由于这些原因,宏需要花费更多的时间来运行.
I am still learning VBA and hence I used macro recorder code and also select / activate
sheets in my code. I know it is not the right way as I don't know the better option other than this. Because of these things, macro is taking more time to run.
如果我不使用 select
代码选择工作表,那么我会收到一条错误消息,并且代码未运行.
If I don't use select
code to select the sheets, then I am getting an error message and code is not running.
如果有人可以帮助我优化此代码,那就太好了,这样执行宏操作将花费更少的时间.
It would be great if someone can help me to optimize this code, so that it will take less time to perform macro operations.
Sub Refresh_AAO_Query()
Dim MyArray, i
Dim Sht, Sht1, Sht2, Sht3, Sht4, Sht5 As Worksheet
Dim OPs_Model_Data, OPs_Data, Sales_Data, Threats_Data, RE_Turnover, RE_LY As Worksheet
Dim Message As String
Dim LastRow1, LastRow2, LastRow3, LastRow4, LastRow5, LastRow6, LoB_LastRow, LoB_LastRow1, LoB_LastRow2, LoB_LastRow3, LastColumn1, LastColumn2, LastColumn3, LastColumn4, LastColumn5, LastColumn6, LastColumn7 As Long
Dim LoB, LoB1, LoB2, LoB3 As ListObject
Dim StartCell0, StartCell1, StartCell2, StartCell3, StartCell4, StartCell5, StartCell6, StartCell7, StartCell8, StartCell9 As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheet2.Visible = xlSheetVisible
Sheet4.Visible = xlSheetVisible
Sheet5.Visible = xlSheetVisible
Sheet9.Visible = xlSheetVisible
Sheet10.Visible = xlSheetVisible
Sheet11.Visible = xlSheetVisible
Sheet12.Visible = xlSheetVisible
Sheet16.Visible = xlSheetVisible
Enable_Analysis_For_Office
Refresh_AAO_Queries
' Fixing "Andhra Pradesh" state issue
MyArray = Array("Sales_Data", "Threats_Data", "RE_Turnover", "RE_LY")
For Each i In MyArray
If Sheets(i).Name <> Sheets("Sales_Data").Name Then
Sheets(i).Activate
Sheets(i).Range("A2:K2").Select
Selection.AutoFilter
ActiveSheet.Range("$A$2:$K$50000").AutoFilter Field:=4, Criteria1:= _
"=Teshima", Operator:=xlOr, Criteria2:="=Teshima?Kaken"
Columns("D:D").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Replace What:="Andhra?Pradesh", Replacement:="Andhra Pradesh", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Selection.AutoFilter
Else
Sheets(i).Activate
Range("A2:Q2").Select
Selection.AutoFilter
ActiveSheet.Range("$A$3:$Q$50000").AutoFilter Field:=4, Criteria1:= _
"=Teshima", Operator:=xlOr, Criteria2:="=Teshima?Kaken"
Columns("D:D").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Replace What:="Andhra?Pradesh", Replacement:="Andhra Pradesh", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Selection.AutoFilter
End If
Next i
' Finding Last Row and Column for("OPs_Model_Data") worksheet
Set Sht = Sheet12
Set Sht1 = Sheet4
Set StartCell0 = Sheet12.Range("A3")
Set StartCell1 = Sheet4.Range("A2")
Sheet4.Select
LastRow1 = Sht1.Cells(Sht1.Rows.Count, StartCell1.Column).End(xlUp).Row
LastColumn1 = Sht1.Cells(StartCell1.Row, Sht1.Columns.Count).End(xlToLeft).Column
Sht1.Range(StartCell1, Sht1.Cells(LastRow1, LastColumn1)).Select
Selection.EntireRow.Delete
Sheet12.Select
LastRow2 = Sht.Cells(Sht.Rows.Count, StartCell0.Column).End(xlUp).Row
LastColumn2 = Sht.Cells(StartCell0.Row, Sht.Columns.Count).End(xlToLeft).Column
Sht.Range(StartCell0, Sht.Cells(LastRow2, LastColumn2)).Select
Selection.Copy
Worksheets("OPs_Model_Data").Range("A2").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheet12.Range("A1").Select
' Refreshing the "Table2" Query
ActiveWorkbook.Connections("Query - Table2").Refresh
' Finding Last Row and Column and updating the data for("RE_LY") worksheet
Sheet11.Select
Set Sht3 = Sheet11
Set LoB1 = Sht3.ListObjects("RE_LY_Table")
Set StartCell4 = Sheet11.Range("A4")
Sht3.ListObjects("RE_LY_Table").DataBodyRange.Delete
LastRow4 = Sht3.Cells(Sht3.Rows.Count, StartCell4.Column).End(xlUp).Row
LastColumn4 = Sht3.Cells(StartCell4.Row, Sht3.Columns.Count).End(xlToLeft).Column
Sht3.Range("A1:K1").Copy
Sht3.Range("A3:K3").PasteSpecial Paste:=xlPasteValues
Sht3.Range("A3:J" & LastRow4).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("RE_LY_Table[Business Function]"), Unique:=True
Set StartCell5 = Sheet11.Range("AA4")
LoB1_LastRow = Sht3.Cells(Sht3.Rows.Count, StartCell5.Column).End(xlUp).Row - 1
LoB1.Resize LoB1.Range.Resize(LoB1_LastRow)
Sht3.Range("AA2:AK2").Copy
Sht3.Range("AA3:AK3").PasteSpecial Paste:=xlPasteValues
Range("AK4").FormulaR1C1 = "=SUMIFS(C[-26],C[-36],RC[-10],C[-35],RC[-9],C[-34],RC[-8],C[-33],RC[-7],C[-32],RC[-6],C[-31],RC[-5],C[-30],RC[-4],C[-29],RC[-3],C[-28],RC[-2],C[-27],RC[-1])"
Range("AK4").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Sht3.Range("AK4").PasteSpecial Paste:=xlPasteValues
Selection.NumberFormat = "0.0"
Sheet11.Range("A1").Select
' Finding Last Row and Column and updating the data for("RE_Turnover") worksheet
Sheet2.Select
Set Sht4 = Sheet2
Set LoB2 = Sht4.ListObjects("RE_Turnover_Table")
Set StartCell6 = Sheet2.Range("A4")
Sht4.ListObjects("RE_Turnover_Table").DataBodyRange.Delete
LastRow5 = Sht4.Cells(Sht4.Rows.Count, StartCell6.Column).End(xlUp).Row
LastColumn5 = Sht4.Cells(StartCell6.Row, Sht4.Columns.Count).End(xlToLeft).Column + 1
Sht4.Range("A1:K1").Copy
Sht4.Range("A3:K3").PasteSpecial Paste:=xlPasteValues
Sht4.Range("A3:J" & LastRow5).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("RE_Turnover_Table[Business Function]"), Unique:=True
Set StartCell7 = Sheet2.Range("AA4")
LoB2_LastRow = Sht4.Cells(Sht4.Rows.Count, StartCell7.Column).End(xlUp).Row - 1
LoB2.Resize LoB2.Range.Resize(LoB2_LastRow)
Sht4.Range("AA2:AK2").Copy
Sht4.Range("AA3:AK3").PasteSpecial Paste:=xlPasteValues
Range("AK4").FormulaR1C1 = "=SUMIFS(C[-26],C[-36],RC[-10],C[-35],RC[-9],C[-34],RC[-8],C[-33],RC[-7],C[-32],RC[-6],C[-31],RC[-5],C[-30],RC[-4],C[-29],RC[-3],C[-28],RC[-2],C[-27],RC[-1])"
Range("AK4").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Sht4.Range("AK4").PasteSpecial Paste:=xlPasteValues
Selection.NumberFormat = "0.0"
Sheet2.Range("A1").Select
' Finding Last Row and Column and updating the data for("Sales_Data") worksheet
Sheet5.Select
Set Sht2 = Sheet5
Set LoB = Sht2.ListObjects("Sales_OPs_Data_Table")
Set StartCell2 = Sheet5.Range("A3")
Sht2.ListObjects("Sales_OPs_Data_Table").DataBodyRange.Delete
LastRow3 = Sht2.Cells(Sht2.Rows.Count, StartCell2.Column).End(xlUp).Row
LastColumn3 = Sht2.Cells(StartCell2.Row, Sht2.Columns.Count).End(xlToLeft).Column + 2
Sht2.Range("A1:Q1").Copy
Sht2.Range("A2:Q2").PasteSpecial Paste:=xlPasteValues
Sht2.Range("A2:J" & LastRow3).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("Sales_OPs_Data_Table[Business Function]"), Unique:=True
Set StartCell3 = Sheet5.Range("AA3")
LoB_LastRow = Sht2.Cells(Sht2.Rows.Count, StartCell3.Column).End(xlUp).Row
LoB.Resize LoB.Range.Resize(LoB_LastRow)
Sht2.Range("AA1:BA1").Copy
Sht2.Range("AA2:BA2").PasteSpecial Paste:=xlPasteValues
Range("AK3").FormulaR1C1 = "=SUMIFS(C[-26],C[-36],[@[Business Function]],C[-35],[@[Industry Group]],C[-34],[@[Industry SubGroup]],C[-33],[@[Customer Group]],C[-32],[@[Resp. SubRegion 1]],C[-31],[@[Sales SubRegion 1]],C[-30],[@[Sales SubRegion 2]],C[-29],[@[Country (End Use)]],C[-28],[@[Sold-to party]],C[-27],[@AccM])"
Range("AL3").FormulaR1C1 = "=SUMIFS(C[-26],C[-37],[@[Business Function]],C[-36],[@[Industry Group]],C[-35],[@[Industry SubGroup]],C[-34],[@[Customer Group]],C[-33],[@[Resp. SubRegion 1]],C[-32],[@[Sales SubRegion 1]],C[-31],[@[Sales SubRegion 2]],C[-30],[@[Country (End Use)]],C[-29],[@[Sold-to party]],C[-28],[@AccM])"
Range("AM3").FormulaR1C1 = "=SUMIFS(C[-26],C[-38],[@[Business Function]],C[-37],[@[Industry Group]],C[-36],[@[Industry SubGroup]],C[-35],[@[Customer Group]],C[-34],[@[Resp. SubRegion 1]],C[-33],[@[Sales SubRegion 1]],C[-32],[@[Sales SubRegion 2]],C[-31],[@[Country (End Use)]],C[-30],[@[Sold-to party]],C[-29],[@AccM])"
Range("AN3").FormulaR1C1 = "=SUMIFS(C[-26],C[-39],[@[Business Function]],C[-38],[@[Industry Group]],C[-37],[@[Industry SubGroup]],C[-36],[@[Customer Group]],C[-35],[@[Resp. SubRegion 1]],C[-34],[@[Sales SubRegion 1]],C[-33],[@[Sales SubRegion 2]],C[-32],[@[Country (End Use)]],C[-31],[@[Sold-to party]],C[-30],[@AccM])"
Range("AO3").FormulaR1C1 = "=SUMIFS(C[-26],C[-40],[@[Business Function]],C[-39],[@[Industry Group]],C[-38],[@[Industry SubGroup]],C[-37],[@[Customer Group]],C[-36],[@[Resp. SubRegion 1]],C[-35],[@[Sales SubRegion 1]],C[-34],[@[Sales SubRegion 2]],C[-33],[@[Country (End Use)]],C[-32],[@[Sold-to party]],C[-31],[@AccM])"
Range("AP3").FormulaR1C1 = "=SUMIFS(C[-26],C[-41],[@[Business Function]],C[-40],[@[Industry Group]],C[-39],[@[Industry SubGroup]],C[-38],[@[Customer Group]],C[-37],[@[Resp. SubRegion 1]],C[-36],[@[Sales SubRegion 1]],C[-35],[@[Sales SubRegion 2]],C[-34],[@[Country (End Use)]],C[-33],[@[Sold-to party]],C[-32],[@AccM])"
Range("AQ3").FormulaR1C1 = "=SUMIFS(RE_Turnover!C[-32],RE_Turnover!C[-42],Sales_Data!RC[-16],RE_Turnover!C[-41],Sales_Data!RC[-15],RE_Turnover!C[-40],Sales_Data!RC[-14],RE_Turnover!C[-39],Sales_Data!RC[-13],RE_Turnover!C[-38],Sales_Data!RC[-12],RE_Turnover!C[-37],Sales_Data!RC[-11],RE_Turnover!C[-36],Sales_Data!RC[-10],RE_Turnover!C[-35],Sales_Data!RC[-9],RE_Turnover!C[-34],Sales_Data!RC[-8],RE_Turnover!C[-33],Sales_Data!RC[-7])"
Range("AR3").FormulaR1C1 = "=SUMIFS(RE_LY!C[-7],RE_LY!C[-17],Sales_Data!RC[-17],RE_LY!C[-16],Sales_Data!RC[-16],RE_LY!C[-15],Sales_Data!RC[-15],RE_LY!C[-14],Sales_Data!RC[-14],RE_LY!C[-13],Sales_Data!RC[-13],RE_LY!C[-12],Sales_Data!RC[-12],RE_LY!C[-11],Sales_Data!RC[-11],RE_LY!C[-10],Sales_Data!RC[-10],RE_LY!C[-9],Sales_Data!RC[-9],RE_LY!C[-8],Sales_Data!RC[-8])"
Range("AS3").FormulaR1C1 = "=SUMIFS(Ops_Data_Backend_Calc!C[-34],Ops_Data_Backend_Calc!C[-44],Sales_Data!RC[-18],Ops_Data_Backend_Calc!C[-43],Sales_Data!RC[-17],Ops_Data_Backend_Calc!C[-42],Sales_Data!RC[-16],Ops_Data_Backend_Calc!C[-41],Sales_Data!RC[-15],Ops_Data_Backend_Calc!C[-40],Sales_Data!RC[-14],Ops_Data_Backend_Calc!C[-39],Sales_Data!RC[-13],Ops_Data_Backend_Calc!C[-38],Sales_Data!RC[-12],Ops_Data_Backend_Calc!C[-37],Sales_Data!RC[-11],Ops_Data_Backend_Calc!C[-36],Sales_Data!RC[-10],Ops_Data_Backend_Calc!C[-35],Sales_Data!RC[-9])"
Range("AT3").FormulaR1C1 = "=SUMIFS(Ops_Data_Backend_Calc!C[-34],Ops_Data_Backend_Calc!C[-45],Sales_Data!RC[-19],Ops_Data_Backend_Calc!C[-44],Sales_Data!RC[-18],Ops_Data_Backend_Calc!C[-43],Sales_Data!RC[-17],Ops_Data_Backend_Calc!C[-42],Sales_Data!RC[-16],Ops_Data_Backend_Calc!C[-41],Sales_Data!RC[-15],Ops_Data_Backend_Calc!C[-40],Sales_Data!RC[-14],Ops_Data_Backend_Calc!C[-39],Sales_Data!RC[-13],Ops_Data_Backend_Calc!C[-38],Sales_Data!RC[-12],Ops_Data_Backend_Calc!C[-37],Sales_Data!RC[-11],Ops_Data_Backend_Calc!C[-36],Sales_Data!RC[-10])"
Range("AU3").FormulaR1C1 = "=SUMIFS(Ops_Data_Backend_Calc!C[-34],Ops_Data_Backend_Calc!C[-46],Sales_Data!RC[-20],Ops_Data_Backend_Calc!C[-45],Sales_Data!RC[-19],Ops_Data_Backend_Calc!C[-44],Sales_Data!RC[-18],Ops_Data_Backend_Calc!C[-43],Sales_Data!RC[-17],Ops_Data_Backend_Calc!C[-42],Sales_Data!RC[-16],Ops_Data_Backend_Calc!C[-41],Sales_Data!RC[-15],Ops_Data_Backend_Calc!C[-40],Sales_Data!RC[-14],Ops_Data_Backend_Calc!C[-39],Sales_Data!RC[-13],Ops_Data_Backend_Calc!C[-38],Sales_Data!RC[-12],Ops_Data_Backend_Calc!C[-37],Sales_Data!RC[-11])"
Range("AV3").FormulaR1C1 = "=SUMIFS(Ops_Data_Backend_Calc!C[-34],Ops_Data_Backend_Calc!C[-47],Sales_Data!RC[-21],Ops_Data_Backend_Calc!C[-46],Sales_Data!RC[-20],Ops_Data_Backend_Calc!C[-45],Sales_Data!RC[-19],Ops_Data_Backend_Calc!C[-44],Sales_Data!RC[-18],Ops_Data_Backend_Calc!C[-43],Sales_Data!RC[-17],Ops_Data_Backend_Calc!C[-42],Sales_Data!RC[-16],Ops_Data_Backend_Calc!C[-41],Sales_Data!RC[-15],Ops_Data_Backend_Calc!C[-40],Sales_Data!RC[-14],Ops_Data_Backend_Calc!C[-39],Sales_Data!RC[-13],Ops_Data_Backend_Calc!C[-38],Sales_Data!RC[-12])"
Range("AW3").FormulaR1C1 = "=SUMIFS(Ops_Data_Backend_Calc!C[-34],Ops_Data_Backend_Calc!C[-48],Sales_Data!RC[-22],Ops_Data_Backend_Calc!C[-47],Sales_Data!RC[-21],Ops_Data_Backend_Calc!C[-46],Sales_Data!RC[-20],Ops_Data_Backend_Calc!C[-45],Sales_Data!RC[-19],Ops_Data_Backend_Calc!C[-44],Sales_Data!RC[-18],Ops_Data_Backend_Calc!C[-43],Sales_Data!RC[-17],Ops_Data_Backend_Calc!C[-42],Sales_Data!RC[-16],Ops_Data_Backend_Calc!C[-41],Sales_Data!RC[-15],Ops_Data_Backend_Calc!C[-40],Sales_Data!RC[-14],Ops_Data_Backend_Calc!C[-39],Sales_Data!RC[-13])"
Range("AX3").FormulaR1C1 = "=SUMIFS(Ops_Data_Backend_Calc!C[-34],Ops_Data_Backend_Calc!C[-49],Sales_Data!RC[-23],Ops_Data_Backend_Calc!C[-48],Sales_Data!RC[-22],Ops_Data_Backend_Calc!C[-47],Sales_Data!RC[-21],Ops_Data_Backend_Calc!C[-46],Sales_Data!RC[-20],Ops_Data_Backend_Calc!C[-45],Sales_Data!RC[-19],Ops_Data_Backend_Calc!C[-44],Sales_Data!RC[-18],Ops_Data_Backend_Calc!C[-43],Sales_Data!RC[-17],Ops_Data_Backend_Calc!C[-42],Sales_Data!RC[-16],Ops_Data_Backend_Calc!C[-41],Sales_Data!RC[-15],Ops_Data_Backend_Calc!C[-40],Sales_Data!RC[-14])"
Range("AY3").FormulaR1C1 = "=SUMIFS(Ops_Data_Backend_Calc!C[-34],Ops_Data_Backend_Calc!C[-50],Sales_Data!RC[-24],Ops_Data_Backend_Calc!C[-49],Sales_Data!RC[-23],Ops_Data_Backend_Calc!C[-48],Sales_Data!RC[-22],Ops_Data_Backend_Calc!C[-47],Sales_Data!RC[-21],Ops_Data_Backend_Calc!C[-46],Sales_Data!RC[-20],Ops_Data_Backend_Calc!C[-45],Sales_Data!RC[-19],Ops_Data_Backend_Calc!C[-44],Sales_Data!RC[-18],Ops_Data_Backend_Calc!C[-43],Sales_Data!RC[-17],Ops_Data_Backend_Calc!C[-42],Sales_Data!RC[-16],Ops_Data_Backend_Calc!C[-41],Sales_Data!RC[-15])"
Range("AZ3").FormulaR1C1 = "=SUMIFS(Ops_Data_Backend_Calc!C[-34],Ops_Data_Backend_Calc!C[-51],Sales_Data!RC[-25],Ops_Data_Backend_Calc!C[-50],Sales_Data!RC[-24],Ops_Data_Backend_Calc!C[-49],Sales_Data!RC[-23],Ops_Data_Backend_Calc!C[-48],Sales_Data!RC[-22],Ops_Data_Backend_Calc!C[-47],Sales_Data!RC[-21],Ops_Data_Backend_Calc!C[-46],Sales_Data!RC[-20],Ops_Data_Backend_Calc!C[-45],Sales_Data!RC[-19],Ops_Data_Backend_Calc!C[-44],Sales_Data!RC[-18],Ops_Data_Backend_Calc!C[-43],Sales_Data!RC[-17],Ops_Data_Backend_Calc!C[-42],Sales_Data!RC[-16])"
Range("BA3").FormulaR1C1 = "=SUMIFS(Ops_Data_Backend_Calc!C[-34],Ops_Data_Backend_Calc!C[-52],Sales_Data!RC[-26],Ops_Data_Backend_Calc!C[-51],Sales_Data!RC[-25],Ops_Data_Backend_Calc!C[-50],Sales_Data!RC[-24],Ops_Data_Backend_Calc!C[-49],Sales_Data!RC[-23],Ops_Data_Backend_Calc!C[-48],Sales_Data!RC[-22],Ops_Data_Backend_Calc!C[-47],Sales_Data!RC[-21],Ops_Data_Backend_Calc!C[-46],Sales_Data!RC[-20],Ops_Data_Backend_Calc!C[-45],Sales_Data!RC[-19],Ops_Data_Backend_Calc!C[-44],Sales_Data!RC[-18],Ops_Data_Backend_Calc!C[-43],Sales_Data!RC[-17])"
Range("AK3:BA3").Select
Selection.Copy
Range("AK3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Sht2.Range("AK3").PasteSpecial Paste:=xlPasteValues
LoB_LastRow = Sht2.Cells(Sht2.Rows.Count, StartCell3.Column).End(xlUp).Row
Range("AK3:BA" & LoB_LastRow).Select
Selection.NumberFormat = "0.0"
Sheet5.Range("A1").Select
' Finding Last Row and Column and updating the data for("Threats_Data") worksheet
Sheet9.Select
Set Sht4 = Sheet9
Set LoB3 = Sht4.ListObjects("Threats_Data_Table")
Set StartCell8 = Sheet9.Range("A3")
Sht4.ListObjects("Threats_Data_Table").DataBodyRange.Delete
LastRow6 = Sht4.Cells(Sht4.Rows.Count, StartCell8.Column).End(xlUp).Row
LastColumn6 = Sht4.Cells(StartCell8.Row, Sht4.Columns.Count).End(xlToLeft).Column
Sht4.Range("A1:Y1").Copy
Sht4.Range("A2:Y2").PasteSpecial Paste:=xlPasteValues
Sht4.Range("A2:Y" & LastRow6).Copy Range("AA2")
Set StartCell9 = Sheet11.Range("AA3")
LoB3_LastRow = Sht4.Cells(Sht4.Rows.Count, StartCell9.Column).End(xlUp).Row
' LoB3.Resize LoB3.Range.Resize(LoB3_LastRow)
Sht4.Range("AA1:AY1").Copy
Sht4.Range("AA2:AK2").PasteSpecial Paste:=xlPasteValues
Range("AU3:AY" & LoB3_LastRow).Select
Selection.NumberFormat = "0.0"
Range("A1").Select
' Replacing the "# and ## to "# - Not assigned"
MyArray = Array("OPs_Model_Data", "OPs_Data", "Sales_Data", "Threats_Data", "RE_Turnover", "RE_LY")
For Each i In MyArray
Sheets(i).Activate
Sheets(i).Range("A1").Select
Cells.Replace What:="##", Replacement:="# - Not assigned", LookAt:= _
xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Cells.Replace What:="#", Replacement:="# - Not assigned", LookAt:=xlWhole _
, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Next i
Sheet6.Select
Range("A1").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
'ActiveWorkbook.RefreshAll
' Refreshing other queries
ActiveWorkbook.Connections("Query - Sales_OPs_Data_Table").Refresh
ActiveWorkbook.Connections("Query - Threats_Data_Table").Refresh
Sheet2.Visible = xlSheetHidden
Sheet4.Visible = xlSheetVeryHidden
Sheet5.Visible = xlSheetHidden
Sheet9.Visible = xlSheetHidden
Sheet12.Visible = xlSheetHidden
Sheet10.Visible = xlSheetVeryHidden
Sheet11.Visible = xlSheetHidden
Sheet16.Visible = xlSheetVeryHidden
End Sub
Public Sub Enable_Analysis_For_Office()
Dim addin As COMAddIn
On Error GoTo AAO_Addin_Err
Dim AddInnStatus As Boolean
AddInnStatus = False
''checks if AAO add-in has been installed or not
For Each addin In ThisWorkbook.Application.COMAddIns
If addin.progID = "SapExcelAddIn" Then
addin.Connect = True
AddInnStatus = True
End If
Next
AAO_Addin_Err:
If AddInnStatus <> True Then
MsgBox "Please install AAO Add-in and re-run the tool", vbCritical, "Missing AAO Add-in"
Exit Sub
End If
End Sub
Public Sub Refresh_AAO_Queries()
lResult = Application.Run("SAPGetProperty", "IsDataSourceActive", "DS_1")
lResult = Application.Run("SAPGetProperty", "IsDataSourceActive", "DS_2")
lResult = Application.Run("SAPGetProperty", "IsDataSourceActive", "DS_3")
lResult = Application.Run("SAPGetProperty", "IsDataSourceActive", "DS_5")
lResult = Application.Run("SAPGetProperty", "IsDataSourceActive", "DS_6")
If lResult = False Then
lResult = Application.Run("SAPExecuteCommand", "Refresh", "DS_1")
lResult = Application.Run("SAPExecuteCommand", "Refresh", "DS_2")
lResult = Application.Run("SAPExecuteCommand", "Refresh", "DS_3")
lResult = Application.Run("SAPExecuteCommand", "Refresh", "DS_5")
lResult = Application.Run("SAPExecuteCommand", "Refresh", "DS_6")
' Example: You can also skip the else
Else
lResult = Application.Run("SAPExecuteCommand", "ShowPrompts", "DS_1")
lResult = Application.Run("SAPExecuteCommand", "ShowPrompts", "DS_2")
lResult = Application.Run("SAPExecuteCommand", "ShowPrompts", "DS_3")
lResult = Application.Run("SAPExecuteCommand", "ShowPrompts", "DS_5")
lResult = Application.Run("SAPExecuteCommand", "ShowPrompts", "DS_6")
End If
End Sub
推荐答案
我通常不会回答这篇文章,但是我会不断遇到此类问题,因此我将分享我的处理方式,希望这对以后的味蕾有帮助也一样但是,请注意,这是我的个人编码风格,可能不是常见的编码风格.随意选择您认为最好的东西.
I usually would not have answered this post but I keep coming across these kind of questions so I will share how I deal with it hoping that this will help future vistiors as well. However, please note that this is my personal coding style and may not be the common acceptable style of coding. Feel free to pick what you think is best.
1..使用选项显式
2..在VBA中(与Vb.net中的说法不同),在声明变量时,请以正确的类型声明所有变量,否则它们将被声明为 Variant
.变体比本机类型慢.您可能想看看在vba中使用变体是否对性能不利?一个>.这是一个例子
2. In VBA (unlike say in Vb.net) when declaring variables, declare all of them with the right type else they will be declared as a Variant
. Variants are slower then native types. You may want to see Is using variants in vba bad for performance?. Here is an example
Dim Sht, Sht1, Sht2, Sht3, Sht4, Sht5 As Worksheet
在上面,仅将 Sht5
声明为 Worksheet
,将 Sht,Sht1,Sht2,Sht3,Sht4
声明为变体
.
In the above, only Sht5
is declared as Worksheet
and Sht, Sht1, Sht2, Sht3, Sht4
are declared as Variants
.
3..无论何时使用事件 ...
3. Whenever you are working with Events...
-
存储默认设置,以便您可以在编码结束时恢复为默认设置.
Store the default settings so that you can revert to it at the end of the coding.
使用错误处理,以便您可以重置原始设置.每当您打开/关闭事件时,请使用错误处理将其重新打开/关闭,否则它们将不会重置.
Use error handling so that you can reset the original settings. Whenever you are switching on/off Events, use error handling to turn it back on/off, else they will not be reset.
这是一个例子
Option Explicit
Sub Sample()
Dim scrnUpdating As Boolean
Dim dsplyAlerts As Boolean
On Error GoTo Whoa
With Application
'~~> Get user's current setting
scrnUpdating = .ScreenUpdating
dsplyAlerts = .DisplayAlerts
'~~> Set it to necessary setting
.ScreenUpdating = False
.DisplayAlerts = False
End With
'~~> Rest of your code
LetsContinue:
With Application
'~~> Reset original settings
.ScreenUpdating = scrnUpdating
.DisplayAlerts = dsplyAlerts
End With
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
4..不要不必要地创建太多变量.只要可能重复使用它们.请参阅下面的第7点.
4. Do not unecessarily create so many variables. Reuse them whenever possible. See point 7 below.
5..如何避免使用在Excel VBA中选择.这也适用于您的情况.看到这个例子
5. How to avoid using Select in Excel VBA. This holds true for your case as well. See this example
您的代码
MyArray = Array("Sales_Data", "Threats_Data", "RE_Turnover", "RE_LY")
For Each i In MyArray
If Sheets(i).Name <> Sheets("Sales_Data").Name Then
'
'
'
Else
'
'
'
End If
Next i
也可以写为
Dim SheetsArray, sht
SheetsArray = Array("Sales_Data", "Threats_Data", "RE_Turnover", "RE_LY")
Dim lRow As Long
Dim rng As Range
For Each sht In SheetsArray
With Sheets(sht)
'~~> Remove any filters
.AutoFilterMode = False
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
If .Name <> "Sales_Data" Then
Set rng = .Range("A2:K" & lRow)
Else
Set rng = .Range("A2:Q" & lRow)
End If
With rng
.AutoFilter Field:=4, Criteria1:="=Teshima", Operator:=xlOr, Criteria2:="=Teshima?Kaken"
End With
With .Columns(4).SpecialCells(xlCellTypeVisible)
.Replace What:="Andhra?Pradesh", Replacement:="Andhra Pradesh", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
End With
'~~> Remove any filters
.AutoFilterMode = False
End With
Next sht
类似地,您的代码
Set Sht = Sheet12
Set Sht1 = Sheet4
Set StartCell0 = Sheet12.Range("A3")
Set StartCell1 = Sheet4.Range("A2")
Sheet4.Select
'
'
'
Worksheets("OPs_Model_Data").Range("A2").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheet12.Range("A1").Select
可以写为
Dim wsA As Worksheet, wsB As Worksheet, wsDest As Worksheet
Dim LastRow As Long, LastCol As Long
Set wsA = Sheet12: Set wsB = Sheet4
Set wsDest = ThisWorkbook.Worksheets("OPs_Model_Data")
LastRow = wsB.Range("A" & wsB.Rows.Count).End(xlUp).Row
wsB.Rows("2:" & wsBLastRow).Delete
With wsA
'~~> Reuse the lastrow variable
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
LastColumn = .Cells(3, .Columns.Count).End(xlToLeft).Column
.Range(.Cells(3, 1), .Cells(LastRow, LastColumn)).Copy
DoEvents
wsDest.Range("A2").PasteSpecial Paste:=xlPasteValues
End With
只需将其复制到 Sheet11
和 Sheet2
.无需使用.选择
.
Simply replicate this for Sheet11
and Sheet2
. No need to use .Select
.
6..请尽可能多地注释您的代码,以便即使在6个月后查看代码也可以理解.
6. Comment your code as much as you can so that you can understand your code when you look at it even after 6 months.
7..要在某个范围内输入公式,则无需在1个单元格中输入该公式,然后将其复制并粘贴下来.您可以一次输入整个范围内的公式.例如,请参考
7. To enter a formula in a range, you do not need to enter the formula in 1 cell and then copy and paste it down. You can enter the formula in the entire range in one go. For example, refer to
Range("AK3").FormulaR1C1 = "=SUMIFS(C[-26],C[-36],[@[Business Function]],C[-35],[@[Industry Group]],C[-34],[@[Industry SubGroup]],C[-33],[@[Customer Group]],C[-32],[@[Resp. SubRegion 1]],C[-31],[@[Sales SubRegion 1]],C[-30],[@[Sales SubRegion 2]],C[-29],[@[Country (End Use)]],C[-28],[@[Sold-to party]],C[-27],[@AccM])"
'
'
'
我将使用一个简单的示例来解释以上内容.假设您要在 AK3
中输入公式 = Sum(A3:L3)
,并希望将相同的公式粘贴到最后一行,则可以写为>
I will explain the above using a simple example. Say you want to enter the formula =Sum(A3:L3)
in AK3
and want the same formula to be pasted down to last row then this can be written as
'~~> Reuse the worksheet variable
Set wsA = Sheet5
With wsA
'~~> Resuse Last Row variable
LastRow = .Range("AK" & .Rows.Count).End(xlUp).Row
With .Range("AK3:AK" & LastRow)
'~~> Enter formula in the entire range
.Formula = "=Sum(A3:L3)"
'~~> Convert to values
.Value = .Value
End With
End With
8..尽可能避免重复编写代码.这将减少您的代码行.考虑该部分
8. Avoid repitivite code as much as possible. This will reduce your code lines. Consider the section
lResult = Application.Run("SAPGetProperty", "IsDataSourceActive", "DS_1")
'
'
'
lResult = Application.Run("SAPGetProperty", "IsDataSourceActive", "DS_6")
这也可以写成
For i = 1 To 6
lResult = Application.Run("SAPGetProperty", "IsDataSourceActive", "DS_" & i)
DoEvents
Next i
注意:
- 我试图尽可能地详尽.如果看到其他内容,我将更新此帖子.
- 我没有测试上面给出的代码段.如果您发现错误或发现任何错误,请随时发表评论,我将对其进行纠正.
- 有趣的读物-致'Err'是人类
这篇关于优化VBA代码并提高性能的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!