简体   繁体   English

VBA自动填充速度问题

[英]VBA Autofill speed issues

I am working on optimising my vba code but until now I haven't succeeded yet. 我正在优化我的vba代码,但是直到现在我还没有成功。 Would there be any possibility that you can look at my code and tell me how I can make it faster? 您是否有可能查看我的代码并告诉我如何使其更快?

I have two excel files: 1 of them is the excel template from which the report will be computed and the other 1 is the generator. 我有两个Excel文件:其中一个是从中计算报告的excel模板,另一个是生成器。 In the attached code, and I know that it is pretty long, you can find the code that has been written. 在随附的代码中(我知道它很长),您可以找到已编写的代码。 I am not sure how to optimise this code any further so any help from your side would be helpful. 我不确定如何进一步优化此代码,因此您方面的任何帮助都会有所帮助。

Thank you, 谢谢,

Jeroen 耶罗恩

Sub Prepare_Files()

    Dim TabName As String

    MacroSheet = "Sheet1"
    File_Loc = "File Locations"
    strReportDate = Worksheets(MacroSheet).Range("I23").Value
    strPrevReportDate = Worksheets(MacroSheet).Range("I26").Value
    strInvoiceDate = Worksheets(MacroSheet).Range("I29").Value
    TemplateAUHUHeadyOpen = False

    EEEEEEEEEJJJ = "A. Oipoip Data - YYYYYY"
    EEEEEEEEEUHUH = "B. Oipoip Data - XXXXXXXXXX"
    QQQQQQ_Inv = "C. QQQQQQ Data - Inventory"
    QQQQQQ_Act = "D. QQQQQQ Data - Active"
    Prod_Data = "E. PROD Data"
    Report_Detail = "F. Report Detail"
    Sales_Summary = "G. Sales Summary"
    US_Trial_Plans = "P. US Trial Plans"
    US_Wholesale_Plans = "Q. US Wholesale Plans"
    CAN_Trial_Plans = "R. CAN Trial Plans"
    CAN_Wholesale_Plans = "S. CAN Wholesale Plans"

    JJJ_NA_Data_Locn = Worksheets(File_Loc).Range("B2").Value
    JJJ_UK_Data_Locn = Worksheets(File_Loc).Range("B3").Value
    JJJ_EU_Data_Locn = Worksheets(File_Loc).Range("B4").Value
    UHUH_NA_Data_Locn = Worksheets(File_Loc).Range("B5").Value
    UHUH_UK_Data_Locn = Worksheets(File_Loc).Range("B6").Value
    UHUH_EU_Data_Locn = Worksheets(File_Loc).Range("B7").Value
    QQQQQQ_Act_Data_Locn = Worksheets(File_Loc).Range("B8").Value
    QQQQQQ_Inv_Data_Locn = Worksheets(File_Loc).Range("B9").Value
    Prod_Build_Data_Locn = Worksheets(File_Loc).Range("B10").Value
    TemplateFiles_Locn = Worksheets(File_Loc).Range("B11").Value
    New_Sales_Report_Locn = Worksheets(File_Loc).Range("B12").Value
    ZZZ_Invoice_Data_Locn = Worksheets(File_Loc).Range("B13").Value
    EEEEEEEEEFile_Locn = Worksheets(File_Loc).Range("B14").Value

    ModelYear1 = Worksheets("Settings").Range("B2").Value
    ModelYear2 = Worksheets("Settings").Range("B3").Value
    ModelYear3 = Worksheets("Settings").Range("B4").Value
    ModelYear4 = Worksheets("Settings").Range("B5").Value
    ModelYear5 = Worksheets("Settings").Range("B6").Value

    ReportNum = Worksheets(MacroSheet).Range("I18").Value

    If ReportNum = 1 Then
        All_Reports = False
        All_Reports_1st_No = 1
        All_Reports_last_No = 1
        TabName = EEEEEEEEEJJJ
        JJJ_Data_Locn = JJJ_NA_Data_Locn
    Else
        Exit Sub
    End If

    For All_Reports_No = All_Reports_1st_No To All_Reports_last_No

        If All_Reports_No = 1 Then
            MarketName = "North America"
            OptOuts_ColNo = OptOuts_ColNo1
            VistaCountryname = VistaCountryname1
            SettingsColumnNo = SettingsColumnNo1
            SheetName_Data_In_Daily_Report = SheetName_Data_In_Daily_Report1
            JJJ_Vista_File_Locn = JJJ_NA_Data_Locn
            UHUH_Vista_File_Locn = UHUH_NA_Data_Locn
        End If

    Next All_Reports_No

    JJJ_VistaFile = Dir$(JJJ_Vista_File_Locn & "\YYYYYY TSTSTSTS - " & MarketName & " - " & Format(strReportDate, "dd-mm-yy") & ".xlsx")
    If Len(JJJ_VistaFile) = 0 Then
        MsgBox ("The Data file 'YYYYYY TSTSTSTS - " & MarketName & " - " & Format(strReportDate, "dd-mm-yy") & ".xlsx""' is missing")
        Exit Sub
    End If

    UHUH_VistaFile = Dir$(UHUH_Vista_File_Locn & "\YHYHYHYHY TSTSTSTS - " & MarketName & " - " & Format(strReportDate, "dd-mm-yy") & ".xlsx")
    If Len(UHUH_VistaFile) = 0 Then
        MsgBox ("The Data file 'YHYHYHYHY TSTSTSTS - " & MarketName & " - " & Format(strReportDate, "dd-mm-yy") & ".xlsx""' is missing")
        Exit Sub
    End If

    OipoipFile = Dir$(EEEEEEEEEFile_Locn & "\ZZZ_reports_" & Format(strReportDate, "yyyy-mm-dd") & ".zip")
    If Len(OipoipFile) = 0 Then
        MsgBox ("The Data file 'ZZZ_reports_" & Format(strReportDate, "yyyy-mm-dd") & ".zip""' is missing")
        Exit Sub
    End If

    QQQQQQInvFile = Dir$(QQQQQQ_Inv_Data_Locn & "\QQQQQQ Inventory_" & Format(strReportDate, "yyyymmdd") & "*.xls")
    If Len(QQQQQQInvFile) = 0 Then
        MsgBox ("The QQQQQQ Inventory Data file 'QQQQQQ Inventory_" & Format(strReportDate, "yyyymmdd") & "*.xls""' is missing")
        Exit Sub
    End If

    QQQQQQActFile = Dir$(QQQQQQ_Act_Data_Locn & "\QQQQQQ Activated_" & Format(strReportDate, "yyyymmdd") & "*.xls")
    If Len(QQQQQQActFile) = 0 Then
        MsgBox ("The QQQQQQ Activated Data file 'QQQQQQ Activated_" & Format(strReportDate, "yyyymmdd") & "*.xls""' is missing")
        Exit Sub
    End If

    ProdBuildFile = Dir$(Prod_Build_Data_Locn & "\Production Build Data IOIOIOIOIOI_PAPAPAPAPAPAPA.xlsx")
    If Len(ProdBuildFile) = 0 Then
        MsgBox ("The Data file 'Production Build Data IOIOIOIOIOI_PAPAPAPAPAPAPA.xlsx' is missing")
        Exit Sub
    End If

    TemplateFile = Dir$(TemplateFiles_Locn & "\Sales Report V6 Template.xlsx")
    If Len(TemplateFile) = 0 Then
        MsgBox ("The Template file 'Sales Report V6 Template.xlsx' is missing")
        Exit Sub
    End If

    PrevReportFile = Dir$(New_Sales_Report_Locn & "\Sales Report V6 - " & Format(strPrevReportDate, "dd.mm.yyyy") & ".xlsx")
    If Len(PrevReportFile) = 0 Then
        MsgBox ("The Previous Report ( 'Sales Report V6 - " & Format(strPrevReportDate, "dd.mm.yyyy") & ".xlsx' ) is not found.")
        Exit Sub
    End If

    ZZZInvoiceFile = Dir$(ZZZ_Invoice_Data_Locn & "\ZZZ Invoice - " & Format(strInvoiceDate, "mm.yyyy") & ".xlsx")
    If Len(ZZZInvoiceFile) = 0 Then
        MsgBox ("The Previous Report ('ZZZ Invoice - " & Format(strInvoiceDate, "mm.yyyy") & ".xlsx' ) is not found.")
        Exit Sub
    End If

    FolderPath = New_Sales_Report_Locn & "\"

    'Copy the YYYYYY Data from the Vista Data file to the Template's EEEEEEEEEJJJ Sheet

    If ReportNum = 1 Then
        'Now that all the required files are present, Copy the first YYYYYY Vista Data file to the Template
        'But first switch off Auto Caluculate in Excel
        'Application.EnableEvents = False
        Application.Calculation = xlCalculationManual

        If All_Reports_No = 1 Then
            TabName = TabName1
            MarketName = MarketName1
        End If

        'Set the Template to y and clear any exisitng data from the Built Orders tab
        If TemplateAUHUHeadyOpen = False Then
            Set wbTemplate = Workbooks.Open(TemplateFiles_Locn & "\" & TemplateFile)
        ElseIf TemplateAUHUHeadyOpen = True Then
            Workbooks.Item(TemplateFile).Activate
        End If

        'Open the YYYYYY Vista Data File & copy the data
        Set wbJJJVista = Workbooks.Open(JJJ_Vista_File_Locn & "\" & JJJ_VistaFile)
        Workbooks.Open(JJJ_Vista_File_Locn & "\" & JJJ_VistaFile).Activate
        Worksheets("All Built Orders").Select
        Range("A1").Select
        Selection.End(xlDown).Select
        NoOfRows_Data = ActiveCell.Row

        'Apply Filters
        ActiveSheet.Range("$A$1:$Y$" & NoOfRows_Data).AutoFilter Field:=1, Criteria1:=Array(""), Operator:=xlFilterValues
        ActiveSheet.ShowAllData
        ActiveSheet.Range("$A$1:$Y$" & NoOfRows_Data).AutoFilter Field:=15, Criteria1:=Array( _
        ModelYear1, _
        ModelYear2, _
        ModelYear3, _
        ModelYear4, _
        ModelYear5), Operator:=xlFilterValues
        Filtered_Total = Application.WorksheetFunction.Subtotal(103, [A2:A1040000])

        Range("A2:Y2").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy

        'Go to the Template File & paste the data into the first sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(EEEEEEEEEJJJ).Range("B2").PasteSpecial
        Application.CutCopyMode = False
        Selection.End(xlDown).Select
        NoOfRows_Data = ActiveCell.Row
        Range("A1").Select

        'Close the Vista Data File, without saIOIOIOIOIOIg
        Workbooks.Item(JJJ_VistaFile).Activate
        ActiveWorkbook.Close SaveChanges:=False


'********
    'Check if the TRTRTRTR Data file exists, in zipped format or the unzipped format
    RTRTRT = Dir$(EEEEEEEEEFile_Locn & "\ZZZ_report_" & Format(strReportDate, "yyyy-mm-dd") & "_3.csv")
    If Len(RTRTRT) = 0 Then
        ZippedRTRTRT = Dir$(EEEEEEEEEFile_Locn & "\ZZZ_reports_" & Format(strReportDate, "yyyy-mm-dd") & ".zip")
        If Len(ZippedRTRTRT) = 0 Then
            MsgBox ("The Zipped TRTRTRTR Data File ( 'ZZZ_reports_" & Format(strReportDate, "yyyy-mm-dd") & ".zip' ) is not found")
            Exit Sub
        Else
            FolderPath = EEEEEEEEEFile_Locn
            zFile = "ZZZ_reports_" & Format(strReportDate, "yyyy-mm-dd") & ".zip"
            UnzipFile FolderPath & "\" & zFile, FolderPath
            RTRTRT = Dir$(EEEEEEEEEFile_Locn & "\ZZZ_report_" & Format(strReportDate, "yyyy-mm-dd") & "_3.csv")
            If Len(RTRTRT) = 0 Then
                MsgBox ("The TRTRTRTR Data File ( ZZZ_report_" & Format(strReportDate, "yyyy-mm-dd") & "_3.csv ) is not found in the zipped file")
                Exit Sub
            Else

                'Copy the WCData from the TRTRTRTR Data file to the Template's WData tab
                'Only need to do this once for all the reports
                Set wbWCData = Workbooks.Open(EEEEEEEEEFile_Locn & "\" & RTRTRT, Format:=4, Delimiter:=",")
                Workbooks.Open(EEEEEEEEEFile_Locn & "\" & RTRTRT, Format:=4, Delimiter:=",").Activate
                Range("A2:C2").Select
                Range(Selection, Selection.End(xlDown)).Select

                'Cells.Select
                Selection.Copy
                Range("A1").Select

                With wbTemplate
                    If TemplateAUHUHeadyOpen = True Then
                        wbTemplate.Sheets("T. Oipoip PAPAPAPAPAPAPA").Range("A2").PasteSpecial
                    Else
                        Workbooks.Item(TemplateFile).Activate
                        wbTemplate.Sheets("T. Oipoip PAPAPAPAPAPAPA").Range("A2").PasteSpecial
                        Worksheets("T. Oipoip PAPAPAPAPAPAPA").Select
                        Range("C:C").Select
                        Selection.NumberFormat = "0"
                    End If

                    Range("A1").Select
                    Application.CutCopyMode = False
                    TemplateAUHUHeadyOpen = True
                    RTRTRT_Populated = True

                End With

                With wbWCData
                    Workbooks.Item(RTRTRT).Close
                End With

            End If
        End If
    Else

        RTRTRT = Dir$(EEEEEEEEEFile_Locn & "\ZZZ_report_" & Format(strReportDate, "yyyy-mm-dd") & "_3.csv")

        'Copy the WCData from the TRTRTRTR Data file to the Template's WData tab
        'Only need to do this once for all the reports
        'Set wbWCData = Workbooks.Open(EEEEEEEEEFile_Locn & "\" & RTRTRT, Format:=4, Delimiter:=",")
        'Workbooks.Open(EEEEEEEEEFile_Locn & "\" & RTRTRT, Format:=4, Delimiter:=",").Activate

        Sheets("T. Oipoip PAPAPAPAPAPAPA").Select
        Range("A1").Select
        ConnectionTxt = "TEXT;" & EEEEEEEEEFile_Locn & "\ZZZ_report_" & Format(strReportDate, "yyyy-mm-dd") & "_3.csv"
        With ActiveSheet.QueryTables.Add(Connection:=ConnectionTxt, Destination:=Range("$A$1"))
'            .CommandType = 0
            .Name = RTRTRT
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 850
            .TextFileStartRow = 2
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 2)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With

        Range("A1").Select

        Range("A1").Select
        Application.CutCopyMode = False
        TemplateAUHUHeadyOpen = True
        RTRTRT_Populated = True

    End If

'********
        'Open the YHYHYHYHY Vista Data File & copy the data
        Set wbUHUHVista = Workbooks.Open(UHUH_Vista_File_Locn & "\" & UHUH_VistaFile)
        'Workbooks.Open(UHUH_Vista_File_Locn & "\" & UHUH_VistaFile).Activate
        Worksheets("All Built Orders").Select
        Range("A1").Select
        Selection.End(xlDown).Select
        NoOfRows_Data = ActiveCell.Row

        'Apply Filters
        ActiveSheet.Range("$A$1:$Y$" & NoOfRows_Data).AutoFilter Field:=1, Criteria1:=Array(""), Operator:=xlFilterValues
        ActiveSheet.ShowAllData
        ActiveSheet.Range("$A$1:$Y$" & NoOfRows_Data).AutoFilter Field:=15, Criteria1:=Array( _
        ModelYear1, _
        ModelYear2, _
        ModelYear3, _
        ModelYear4, _
        ModelYear5), Operator:=xlFilterValues
        Filtered_Total = Application.WorksheetFunction.Subtotal(103, [A2:A1040000])

        'Range("A2:Y2").Select
        Range("A2:Y" & NoOfRows_Data).Select
        Selection.Copy

        'Go to the Template File & paste the data into the second sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(EEEEEEEEEUHUH).Range("B2").PasteSpecial
        Application.CutCopyMode = False
        Worksheets(EEEEEEEEEUHUH).Select
        Range("A1").Select
        'Selection.End(xlDown).Select
        'NoOfRows_Data = ActiveCell.Row

        'Close the Vista Data File, without saIOIOIOIOIOIg
        'Workbooks.Open(UHUH_Vista_File_Locn & "\" & UHUH_VistaFile).Activate
        Workbooks.Item(UHUH_VistaFile).Activate
        ActiveWorkbook.Close SaveChanges:=False

'********
        'Open the QQQQQQ Inventory Data File & copy the data
        Set wbJasInv = Workbooks.Open(QQQQQQ_Inv_Data_Locn & "\" & QQQQQQInvFile)
        Worksheets("Sheet0").Select
        Range("A2").Select
        Selection.End(xlDown).Select
        NoOfRows_Data = ActiveCell.Row

        Range("A2:B2").Select
        Range("A2:B" & NoOfRows_Data).Select
        Selection.Copy

        'Go to the Template File & paste the data into the third sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(QQQQQQ_Inv).Range("B2").PasteSpecial
        Application.CutCopyMode = False

        Workbooks.Item(QQQQQQInvFile).Activate
        Worksheets("Sheet0").Select
        Range("M2:N" & NoOfRows_Data).Select
        Selection.Copy

        'Go to the Template File & paste the data into the third sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(QQQQQQ_Inv).Range("D2").PasteSpecial
        Application.CutCopyMode = False

        Workbooks.Item(QQQQQQInvFile).Activate
        Worksheets("Sheet0").Select
        Range("D2:E" & NoOfRows_Data).Select
        Selection.Copy

        'Go to the Template File & paste the data into the third sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(QQQQQQ_Inv).Range("F2").PasteSpecial
        Application.CutCopyMode = False

        Workbooks.Item(QQQQQQInvFile).Activate
        Worksheets("Sheet0").Select
        Range("H2:H" & NoOfRows_Data).Select
        Selection.Copy

        'Go to the Template File & paste the data into the third sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(QQQQQQ_Inv).Range("H2").PasteSpecial
        Application.CutCopyMode = False

        Workbooks.Item(QQQQQQInvFile).Activate
        Worksheets("Sheet0").Select
        Range("J2:K" & NoOfRows_Data).Select
        Selection.Copy

        'Go to the Template File & paste the data into the third sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(QQQQQQ_Inv).Range("I2").PasteSpecial
        Application.CutCopyMode = False
        Worksheets(QQQQQQ_Inv).Select
        Range("A1").Select

        'Close the Vista Data File, without saIOIOIOIOIOIg
        Workbooks.Open(QQQQQQ_Inv_Data_Locn & "\" & QQQQQQInvFile).Activate
        ActiveWorkbook.Close SaveChanges:=False

        'Open the QQQQQQ Activated Data File & copy the data
        Set wbJasAct = Workbooks.Open(QQQQQQ_Act_Data_Locn & "\" & QQQQQQActFile)
        Worksheets("Sheet0").Select
        Range("A2").Select
        Selection.End(xlDown).Select
        NoOfRows_Data = ActiveCell.Row
        Range("A2:A" & NoOfRows_Data).Select
        Selection.Copy

        'Go to the Template File & paste the data into the third sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(QQQQQQ_Act).Range("B2").PasteSpecial
        Application.CutCopyMode = False

        Workbooks.Item(QQQQQQActFile).Activate
        Worksheets("Sheet0").Select
        Range("O2:O" & NoOfRows_Data).Select
        Selection.Copy

        'Go to the Template File & paste the data into the third sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(QQQQQQ_Act).Range("C2").PasteSpecial
        Application.CutCopyMode = False

        'Set wbJasAct = Workbooks.Open(QQQQQQ_Act_Data_Locn & "\" & QQQQQQActFile)
        Workbooks.Item(QQQQQQActFile).Activate
        Worksheets("Sheet0").Select
        Range("B2:B" & NoOfRows_Data).Select
        Selection.Copy

        'Go to the Template File & paste the data into the third sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(QQQQQQ_Act).Range("D2").PasteSpecial
        Application.CutCopyMode = False

        Workbooks.Item(QQQQQQActFile).Activate
        Worksheets("Sheet0").Select
        Range("M2:N" & NoOfRows_Data).Select
        Selection.Copy

        'Go to the Template File & paste the data into the third sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(QQQQQQ_Act).Range("E2").PasteSpecial
        Application.CutCopyMode = False

        Workbooks.Item(QQQQQQActFile).Activate
        Worksheets("Sheet0").Select
        Range("D2:E" & NoOfRows_Data).Select
        Selection.Copy

        'Go to the Template File & paste the data into the third sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(QQQQQQ_Act).Range("G2").PasteSpecial
        Application.CutCopyMode = False
        Worksheets(QQQQQQ_Inv).Select

        Workbooks.Item(QQQQQQActFile).Activate
        Worksheets("Sheet0").Select
        Range("H2:H" & NoOfRows_Data).Select
        Selection.Copy

        'Go to the Template File & paste the data into the third sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(QQQQQQ_Act).Range("I2").PasteSpecial
        Application.CutCopyMode = False
        Worksheets(QQQQQQ_Inv).Select

        Workbooks.Item(QQQQQQActFile).Activate
        Worksheets("Sheet0").Select
        Range("J2:K" & NoOfRows_Data).Select
        Selection.Copy

        'Go to the Template File & paste the data into the third sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(QQQQQQ_Act).Range("J2").PasteSpecial
        Application.CutCopyMode = False
        Worksheets(QQQQQQ_Act).Select
        Range("A1").Select

        'Close the Vista Data File, without saIOIOIOIOIOIg
        Workbooks.Item(QQQQQQActFile).Activate
        ActiveWorkbook.Close SaveChanges:=False

        'Open the Production Build Data File & copy the data
        Set wbJasAct = Workbooks.Open(Prod_Build_Data_Locn & "\" & ProdBuildFile)
        Worksheets("PROD_IOIOIOIOIOI_PAPAPAPAPAPAPA").Select
        Range("A2:D2").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy

        'Go to the Template File & paste the data into the third sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(Prod_Data).Range("C2").PasteSpecial
        Application.CutCopyMode = False
        Worksheets(Prod_Data).Select
        Range("A1").Select

        'Close the Production Build Data File, without saIOIOIOIOIOIg
        Workbooks.Open(Prod_Build_Data_Locn & "\" & ProdBuildFile).Activate
        ActiveWorkbook.Close SaveChanges:=False

        'Open the ZZZ Invoice Data File & copy the data set 1
        Set wbJasAct = Workbooks.Open(ZZZ_Invoice_Data_Locn & "\" & ZZZInvoiceFile)
        'Workbooks.Open(ZZZ_Invoice_Data_Locn & "\" & ZZZInvoiceFile).Activate
        Worksheets("US - Other Charges (Trial Fee)").Select
        Range("A7:I7").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy

        'Go to the Template File & paste the data into the data trial summary sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(US_Trial_Plans).Range("A2").PasteSpecial
        Application.CutCopyMode = False
        Worksheets(US_Trial_Plans).Select
        Range("A1").Select

        'Close the Invoice File, without saIOIOIOIOIOIg
        Workbooks.Open(ZZZ_Invoice_Data_Locn & "\" & ZZZInvoiceFile).Activate
        ActiveWorkbook.Close SaveChanges:=False

        'Open the ZZZ Invoice Data File & copy the data set 2
        Set wbJasAct = Workbooks.Open(ZZZ_Invoice_Data_Locn & "\" & ZZZInvoiceFile)
        'Workbooks.Open(ZZZ_Invoice_Data_Locn & "\" & ZZZInvoiceFile).Activate
        Worksheets("US - January Rate Plan Detail ").Select
        Range("A10:H10").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy

        'Go to the Template File & paste the data into the data wholesale summary sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(US_Wholesale_Plans).Range("A2").PasteSpecial
        Application.CutCopyMode = False
        Worksheets(US_Wholesale_Plans).Select
        Range("A1").Select

        'Close the Invoice File, without saIOIOIOIOIOIg
        Workbooks.Open(ZZZ_Invoice_Data_Locn & "\" & ZZZInvoiceFile).Activate
        ActiveWorkbook.Close SaveChanges:=False

        'Open the ZZZ Invoice Data File & copy the data set 3
        Set wbJasAct = Workbooks.Open(ZZZ_Invoice_Data_Locn & "\" & ZZZInvoiceFile)
        Worksheets("CAN Other Charges (Trial Fee) ").Select
        Range("A7:I7").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy

The rest of the code will be in the comment of this query. 其余代码将在此查询的注释中。

This it the rest of the code... 这是其余的代码...

'Go to the Template File & paste the data into the data trial summary sheet
            Workbooks.Item(TemplateFile).Activate
            Sheets(CAN_Trial_Plans).Range("A2").PasteSpecial
            Application.CutCopyMode = False
            Worksheets(CAN_Trial_Plans).Select
            Range("A1").Select

        'Close the Invoice File, without saIOIOIOIOIOIg
        Workbooks.Open(ZZZ_Invoice_Data_Locn & "\" & ZZZInvoiceFile).Activate
        ActiveWorkbook.Close SaveChanges:=False

        'Open the ZZZ Invoice Data File & copy the data set 4
        Set wbJasAct = Workbooks.Open(ZZZ_Invoice_Data_Locn & "\" & ZZZInvoiceFile)
        Worksheets("CAN January Rate Plan Detail").Select
        Range("A8:N8").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy

        'Go to the Template File & paste the data into the data wholesale summary sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(CAN_Wholesale_Plans).Range("A2").PasteSpecial
        Application.CutCopyMode = False
        Worksheets(CAN_Wholesale_Plans).Select
        Range("A1").Select

        'Close the Invoice File, without saIOIOIOIOIOIg
        Workbooks.Open(ZZZ_Invoice_Data_Locn & "\" & ZZZInvoiceFile).Activate
        ActiveWorkbook.Close SaveChanges:=False

        'Extend down all the formulae in the Template file
        Workbooks.Item(TemplateFile).Activate
        Worksheets(EEEEEEEEEJJJ).Select
        Range("B2").Select
        Selection.End(xlDown).Select
        NoOfRows_Data = ActiveCell.Row
        NoOfRows1 = "A2:A" & NoOfRows_Data
        Range("A2").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)

        NoOfRows1 = "AA2:AA" & NoOfRows_Data
        Range("AA2:AA2").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)
        Range("A1").Select

        Worksheets(EEEEEEEEEUHUH).Select
        Range("B2").Select
        Selection.End(xlDown).Select
        NoOfRows_Data = ActiveCell.Row
        NoOfRows1 = "A2:A" & NoOfRows_Data
        Range("A2").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)
        Range("A1").Select

        NoOfRows1 = "AA2:AA" & NoOfRows_Data
        Range("AA2:AA2").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)
        Range("A1").Select

        Worksheets(QQQQQQ_Inv).Select
        Range("B2").Select
        Selection.End(xlDown).Select
        NoOfRows_Data = ActiveCell.Row
        NoOfRows1 = "A2:A" & NoOfRows_Data
        Range("A2").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)
        Range("L2").Value = Format(strReportDate, "dd-mmm-yyyy")
        Range("A1").Select

        Worksheets(QQQQQQ_Act).Select
        Range("B2").Select
        Selection.End(xlDown).Select
        NoOfRows_Data = ActiveCell.Row
        NoOfRows1 = "A2:A" & NoOfRows_Data
        Range("A2").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)
        Range("W2").Value = Format(strReportDate, "dd-mmm-yyyy")
        Range("X2").Value = Format(Now(), "dd-mmm-yyyy")
        Range("A1").Select

        NoOfRows1 = "L2:P" & NoOfRows_Data
        Range("L2:P2").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)
        Range("A1").Select

        NoOfRows1 = "Q2:Q" & NoOfRows_Data
        Range("Q2").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)
        Range("A1").Select

        NoOfRows1 = "R2:V" & NoOfRows_Data
        Range("R2:V2").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)
        Range("A1").Select

        Worksheets(Prod_Data).Select
        Range("C2").Select
        Selection.End(xlDown).Select
        NoOfRows_Data = ActiveCell.Row
        NoOfRows1 = "A2:B" & NoOfRows_Data
        Range("A2:B2").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)
        Range("N2").Value = Format(strReportDate, "dd-mmm-yyyy")
        Range("A1").Select

        NoOfRows1 = "G2:J" & NoOfRows_Data
        Range("G2:J2").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)
        Range("A1").Select

        NoOfRows1 = "K2:K" & NoOfRows_Data
        Range("K2:K2").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)
        Range("A1").Select

        NoOfRows1 = "L2:L" & NoOfRows_Data
        Range("L2:L2").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)
        Range("A1").Select

        'Report Detail
        Worksheets(Report_Detail).Select
        Range("A3").Select
        NoOfRows1 = "A3:AB" & NoOfRows_Data
        Range("A3:AB3").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)

        NoOfRows1 = "AC3:AC" & NoOfRows_Data
        Range("AC3").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)
        Range("A1").Select

        NoOfRows1 = "AE3:AL" & NoOfRows_Data
        Range("AE3:AL3").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)
        Range("A1").Select

        'Now switch on the Auto Caluculate in Excel
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic

    Worksheets(EEEEEEEEEJJJ).Select
    Range("B2").Select

    Sheets(Sales_Summary).Select

    Range("K16").Select
    ActiveSheet.PivotTables("PivotTable4").PivotCache.Refresh
    Range("K4").Select
    ActiveSheet.PivotTables("PivotTable3").PivotCache.Refresh
    Range("A4").Select
    ActiveSheet.PivotTables("PivotTable2").PivotCache.Refresh
    Range("A16").Select
    ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh

    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    'Replace all the formulae with actual values to speed up opening the report afterwards
    Workbooks.Item(TemplateFile).Activate
    Worksheets(EEEEEEEEEJJJ).Select
    Range("A2").Select
    Selection.End(xlDown).Select
    NoOfRows_Data = ActiveCell.Row
    Range("A2:A" & NoOfRows_Data).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select

    'Workbooks.Item(TemplateFile).Activate
    Worksheets(EEEEEEEEEUHUH).Select
    Range("A2:A" & NoOfRows_Data).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select

    'Workbooks.Item(TemplateFile).Activate
    Worksheets(QQQQQQ_Inv).Select
    Range("A2:A" & NoOfRows_Data).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets(QQQQQQ_Inv).Range("A2").PasteSpecial
    Application.CutCopyMode = False
    Range("A1").Select

    'Workbooks.Item(TemplateFile).Activate
    Worksheets(QQQQQQ_Act).Select
    Range("A2:A" & NoOfRows_Data).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select

    'Workbooks.Item(TemplateFile).Activate
    Worksheets(QQQQQQ_Act).Select
    Range("L2:V" & NoOfRows_Data).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select

    'Workbooks.Item(TemplateFile).Activate
    Worksheets(Prod_Data).Select
    Range("A2:B" & NoOfRows_Data).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select

    'Workbooks.Item(TemplateFile).Activate
    Worksheets(Prod_Data).Select
    Range("G2:L" & NoOfRows_Data).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select

    'Workbooks.Item(TemplateFile).Activate
    Worksheets(Report_Detail).Select
    Range("A3:AL" & NoOfRows_Data).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select

    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic

    'Save the Template As the Activation Report file
    ActiveWorkbook.SaveAs Filename:=(New_Sales_Report_Locn & "\Sales Report V6 - " & Format(strReportDate, "dd.mm.yyyy") & ".xlsx")
    ActiveWorkbook.Close SaveChanges:=True
End If


MsgBox ("The Daily Report(s) generation is now complete.")

End Sub

Sub UnzipFile(ByVal sZipFile As String, ByVal sDestFolder As String)

    Dim objApp As Object
    Dim objArchive As Object
    Dim objDest As Object
    Dim vDestFolder As Variant
    Dim vZipFile As Variant

    Set objApp = CreateObject("Shell.Application")

    vZipFile = sZipFile
    vDestFolder = sDestFolder

    If Dir$(sDestFolder, vbDirectory) = "" Then MkDir sDestFolder

    objApp.Namespace(vDestFolder).CopyHere objApp.Namespace(vZipFile).Items

End Sub
  1. Extend down all the formulas in the template file (these formula's are mostly Index+Match formula's) 扩展模板文件中的所有公式(这些公式主要是“索引+匹配”公式)
  2. Copy the formula's as values to speed up opening the report afterwards 复制公式的值,以加快以后打开报告的速度

This is a duplication of effort. 这是重复的工作。 Depending on how many formulae you have, one thing that could speed this up A LOT would be to use VBA to calculate the values. 根据您拥有的公式的多少,可以加快处理速度的一件事是使用VBA计算值。 At the moment, you're using VBA to copy and paste formulae, waiting for the formulae to calculate, copying the formulae, then pasting as values. 目前,您正在使用VBA复制和粘贴公式,等待公式计算,然后复制公式,然后将其粘贴为值。 Just doing the whole calculation in VBA and placing the end result into the spreadsheet should be way quicker. 只需在VBA中进行整个计算并将最终结果放入电子表格中,便会更快。 You can use Application.WorksheetFunction to put any function that works in a spreadsheet into your VBA. 您可以使用Application.WorksheetFunction将电子表格中可以使用的任何函数放入VBA。

I also see you're opening files then closing them without saving changes. 我还看到您正在打开文件,然后关闭文件而不保存更改。 Try opening them with ReadOnly:=True . 尝试使用ReadOnly:=True打开它们。 It can make a big speed difference. 它可以产生很大的速度差异。


Added later: 稍后添加:

Depends what you're looking up, but, if you do take my advice and do all the calculation within the VBA, you might well find that Find and Offset are more efficient than MATCH and INDEX . 取决于您要查找的内容,但是,如果您采纳我的建议并在VBA中进行了所有计算,则可能会发现FindOffsetMATCHINDEX更有效。 By sheer coincidence, I posted an example of using Find and Offset earlier today: https://stackoverflow.com/a/39410878/2475052 碰巧的是,我今天早些时候发布了一个使用“ FindOffset的示例: https : //stackoverflow.com/a/39410878/2475052

does anyone know how to add this code to make it a readonly spreadsheet open? 有谁知道如何添加此代码以使其成为只读电子表格?

'Open the YYYYYY Vista Data File & copy the data
        Set wbJJJVista = Workbooks.Open(JJJ_Vista_File_Locn & "\" & JJJ_VistaFile)
        Workbooks.Open(JJJ_Vista_File_Locn & "\" & JJJ_VistaFile).Activate
        Worksheets("All Built Orders").Select
        Range("A1").Select
        Selection.End(xlDown).Select
        NoOfRows_Data = ActiveCell.Row

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

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