优化VBA代码，提升性能 [英] Optimizing the VBA Code and improve the performance

查看：30 发布时间：2021/12/25 12:15:19 excel vba excel-formula office365 vba7

本文介绍了优化VBA代码，提升性能的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

我开发了一个 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.每当您使用事件...

存储默认设置，以便您可以在编码结束时恢复到它.

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 复制这个.无需使用 .Select.

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

注意:

我已尽量详细说明.如果我看到任何其他内容，我会更新此帖子.
我还没有测试我上面给出的代码片段.如果您发现错误或发现任何错误，请随时发表评论，我会更正.
有趣的阅读 - To 'Err'是人类

这篇关于优化VBA代码，提升性能的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！

查看全文

优化VBA代码，提升性能 [英] Optimizing the VBA Code and improve the performance

问题描述

推荐答案

相关文章

其他开发最新文章

热门教程

热门工具

登录关闭

优化VBA代码，提升性能 [英] Optimizing the VBA Code and improve the performance

问题描述

推荐答案

相关文章

其他开发最新文章

热门教程

热门工具

登录 关闭

登录关闭