Question

我正在努力优化我的vba代码，但直到现在我还没有成功。您是否有可能查看我的代码并告诉我如何让它更快？

我有两个excel文件：其中一个是excel模板，报告将从中计算，另一个是生成器。在附带的代码中，我知道它很长，你可以找到已编写的代码。我不确定如何进一步优化此代码，以便您身边的任何帮助都会有所帮助。

谢谢，

的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

其余代码将出现在此查询的注释中。

Answer 1

这是代码的其余部分......

'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

Answer 2

扩展模板文件中的所有公式（这些公式主要是索引+匹配公式）

将公式复制为值以加快后续打开报告

这是一种重复的努力。根据您拥有的公式数量，可以加快速度的一件事就是使用VBA来计算值。目前，您正在使用VBA复制和粘贴公式，等待公式计算，复制公式，然后粘贴为值。只是在VBA中进行整个计算并将最终结果放入电子表格应该更快。您可以使用Application.WorksheetFunction将电子表格中的任何功能放入您的VBA。

我也看到你打开文件然后关闭它们而不保存更改。尝试使用ReadOnly:=True打开它们。它可以产生很大的速度差异。

稍后添加：

取决于您正在查找的内容，但是，如果您确实接受了我的建议并在VBA中进行了所有计算，您可能会发现Find和Offset比{MATCH更有效率1}}和INDEX。纯粹巧合，我今天早些时候发布了一个使用Find和Offset的示例：https://stackoverflow.com/a/39410878/2475052

Answer 3

是否有人知道如何添加此代码以使其成为只读电子表格？

'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

VBA自动填充速度问题

3 个答案: