即使 Excel 工作簿为空，Excel 宏文件也太大答案

【问题标题】：Excel Macro file size is too huge even though excel workbook is empty即使 Excel 工作簿为空，Excel 宏文件也太大
【发布时间】：2022-01-21 14:20:34
【问题描述】：

我创建了一个简单的宏，它将 3 个 xls 文件导入宏，并将比较数据并创建一个包含有限字段的输出文件。但我看到我的宏文件是 33,446 KB，即使宏书页是空的。

有什么方法可以在不逐步执行的情况下找出哪一行代码耗时？

输入文件及其文件大小

Excel 宏文件大小

    Sub Macro_Step_1()
    Dim Wkb_1 As Workbook
    Dim Autosht As Worksheet, DLDataSht As Worksheet, SAPdataSht As Worksheet, Osht As Worksheet
    
    Set Wkb_1 = ThisWorkbook
    Set Autosht = Wkb_1.Sheets("Automation")
    Set DLDataSht = Wkb_1.Sheets("GLData")
    Set SAPdataSht = Wkb_1.Sheets("YFIINTDSRP")
    Set Osht = Wkb_1.Sheets("Output File")
    Set Tempsht = Wkb_1.Sheets("Temp")
    
    St = Now()
    
    Call TurnOffStuff
    
    wkbpath = Wkb_1.Path
    
    '***************************************************************************************************************************************
    FN = Dir(wkbpath & "\*.*")
    
            Do While FN <> ""
                        Debug.Print FN
                    If LCase(FN) Like LCase("*Report*.xls") Then
                        Compinfo = Compinfo & "|" & FN
                        Compinfo = IIf(Left(Compinfo, 1) = "|", Mid(Compinfo, 2, Len(Compinfo)), Compinfo)
                    ElseIf LCase(FN) Like LCase("*Raw*.xlsx") Then
                        LMPTinfo = FN
                        
                    End If
            FN = Dir()
            Loop
            
    '*******************************************Input Files missing alert******************************************************************
          If Compinfo = "" Or LMPTinfo = "" Then
            ReportName = ""
            ReportName = wkbpath & "\" & "Missing Input Files.txt"
            Open ReportName For Output As #1
            Close #1
            Exit Sub
            ReportName = ""
          End If
          
    '------------------------------------------------------------------------------
        '//Clear Contents for Below mentioned Sheets Exluding Header
    
        Wkb_1.Activate
        
        DLDataSht.Rows("2:1000000").EntireRow.Clear
        
        SAPdataSht.Rows("2:1000000").EntireRow.Clear
        
        Tempsht.Rows("2:1000000").EntireRow.Clear
        
        Osht.Rows("1:1000000").EntireRow.Clear
    '*****************************Client Data***********************************************************************************************
     
     
    RptName = Split(Compinfo, "|")
     
         For Each Rsht In RptName
         
            Call Copy_Compinfo_Data("" & Rsht & "", "", "YFIINTDSRP")
        
         Next
    
    Call Copy_LMPTinfo_Data("" & LMPTinfo & "", "", "GLData")
    
    
    
    
    Call OutputMdl
    
    Tempsht.Rows("1:1000000").EntireRow.Clear
    
    '*********************************************************************************************************************************
    
    Call TurnONStuff
    
     '//Automation Run Time & Task Completetion Alert
        MsgBox "Process Completed Within " & Format(Now() - St, "HH:MM:SS"), vbInformation
    
    End Sub

Sub Copy_Compinfo_Data(IPWkb As String, IPSheet As String, DestSheetname As String)
Dim Del_1 As Long

Set Wkb_1 = ThisWorkbook
Set Tempsht = Wkb_1.Sheets("Temp")

    Tempsht.Rows("1:1000000").EntireRow.Clear

wkbpath = ThisWorkbook.Path

ShtInx = IIf(IPSheet = "", 1, IPSheet)


Set ws_master = Workbooks.Open(wkbpath & "\" & IPWkb)
    Shtname = ws_master.Sheets(1).Name
Set ws_Data = ws_master.Sheets(ShtInx)
    

Wkb_1.Activate
Set OrgFl = Wkb_1.Sheets(DestSheetname)

OrgFl.Select

ws_master.Sheets(1).Activate
Application.CutCopyMode = False
ws_Data.Cells.Copy

Tempsht.Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False


ws_master.Activate

Windows(IPWkb).Close savechanges:=False


Wkb_1.Activate: Tempsht.Select
'HDRrow = 1

        Tempsht.Rows("1:7").EntireRow.Delete
        Tempsht.Range("A:A").EntireColumn.Delete
        Tempsht.Rows("2:2").EntireRow.Delete
        Tempsht.Range("C:C").EntireColumn.Delete
        
        Tempsht.Sort.SortFields.Clear
        Tempsht.Sort.SortFields.Add2 Key:=Range("A2:A" & LR), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Tempsht.Sort
        .SetRange Range("A1:AB" & LR)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
        
        Wkb_1.Activate: Tempsht.Select
        
    If Tempsht.AutoFilterMode Then Tempsht.AutoFilterMode = False
        
    Tempsht.Range(Cells(1, 1), Cells(LR, LC)).AutoFilter field:=1, Criteria1:="Company Code"
    If LR > 1 Then
        Tempsht.Range(Cells(2, 1), Cells(LR, LC)).SpecialCells(xlCellTypeVisible).Delete
    End If
    Tempsht.ShowAllData
        
        
     '   For Del_1 = LR To 1 Step -1
        'Wkb_1.Activate: Tempsht.Select
            'Tempsht.Range(Cells(Del_1, 1), Cells(Del_1, LC)).Select
      '      Coun_ta = Application.WorksheetFunction.CountA(Tempsht.Range(Cells(Del_1, 1), Cells(Del_1, LR)))
            
       '     If Tempsht.Range("B" & Del_1) = "" And Coun_ta <= 0 Then
                'Tempsht.Rows(Del_1).EntireRow.Select
                'Tempsht.Rows(Del_1).EntireRow.Delete
                
        '    ElseIf Tempsht.Range("A" & Del_1) = "*" Then
                'Tempsht.Rows(Del_1).EntireRow.Select
                'Tempsht.Rows(Del_1).EntireRow.Delete
         '   End If
            
        'Next
        
        Wkb_1.Activate: Tempsht.Select
    
    Tempsht.Cells(1, LC + 1) = "Report Name"
    'Tempsht.Range(Cells(2, LC), Cells(LR, LC)).Select
    Tempsht.Range(Cells(2, LC), Cells(LR, LC)) = IPWkb
        
        Application.CutCopyMode = False
        Tempsht.Range(Cells(2, 1), Cells(LR, LC)).Copy
        
        Wkb_1.Activate
        
OrgFl.Select
OrgFl.Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Wkb_1.Activate: OrgFl.Select: OrgFl.Range("A1").Select

Application.CutCopyMode = False


End Sub

Sub Copy_LMPTinfo_Data(IPWkb As String, IPSheet As String, DestSheetname As String)
Set Wkb_1 = ThisWorkbook
Set Tempsht = Wkb_1.Sheets("Temp")
Set Osht = Wkb_1.Sheets("Output File")
Set DLDataSht = Wkb_1.Sheets("GLData")

    Tempsht.Rows("1:1000000").EntireRow.Clear
    DLDataSht.Rows("2:1000000").EntireRow.Clear
    
wkbpath = ThisWorkbook.Path


Set ws_master = Workbooks.Open(wkbpath & "\" & IPWkb)
    Shtname = ws_master.Sheets(1).Name

Sht_Count = ws_master.Sheets.Count


For ShtInx = 1 To Sht_Count
    Shtname = ws_master.Sheets(ShtInx).Name
Set ws_Data = ws_master.Sheets(ShtInx)
    
Wkb_1.Activate
Set OrgFl = Wkb_1.Sheets(DestSheetname)

OrgFl.Select
'OrgFl.Cells.Clear

ws_master.Sheets(Shtname).Activate
Application.CutCopyMode = False
ws_Data.Cells.Copy

Tempsht.Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

Tempsht.Rows("1:1").EntireRow.Delete


        Tempsht.Columns("D:D").TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
        
        Tempsht.Columns("F:F").TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
        
        Tempsht.Columns("J:J").TextToColumns Destination:=Range("J1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
        
        Tempsht.Columns("M:M").TextToColumns Destination:=Range("M1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
        
        Tempsht.Columns("Q:Q").TextToColumns Destination:=Range("Q1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
        
        Tempsht.Columns("U:U").TextToColumns Destination:=Range("U1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True


        Tempsht.Columns("G:H").NumberFormat = "MM/DD/YYYY"
        TEmpLastRow = Tempsht.Cells(Rows.Count, 3).End(xlUp).Row
  
        Tempsht.Columns("A").Insert: Tempsht.Range("A1") = "Month"
        Wkb_1.Activate: Tempsht.Select
        Tempsht.Range(Cells(2, "A"), Cells(TEmpLastRow, "A")) = Shtname & "'" & Format(Now(), "YY")
        
        Wkb_1.Activate: Tempsht.Select
        Application.CutCopyMode = False
        Tempsht.Range(Cells(2, 1), Cells(LR, LC)).Copy
        Wkb_1.Activate
        DLDataSht.Select
              LastRow = DLDataSht.Cells(Rows.Count, 3).End(xlUp).Row
        DLDataSht.Range("A" & LastRow + 1).PasteSpecial
        Application.CutCopyMode = False
        
ws_master.Activate

Next

Windows(IPWkb).Close savechanges:=False


End Sub

Sub OutputMdl()
Set Wkb_1 = ThisWorkbook
Set Autosht = Wkb_1.Sheets("Automation")
Set DLDataSht = Wkb_1.Sheets("GLData")
Set SAPdataSht = Wkb_1.Sheets("YFIINTDSRP")
Set Osht = Wkb_1.Sheets("Output File")
Set Tempsht = Wkb_1.Sheets("Temp")

Osht.Rows("1:1000000").EntireRow.Clear

Wkb_1.Activate: Osht.Select

        Wkb_1.Activate: DLDataSht.Select
        Application.CutCopyMode = False
        DLDataSht.Range(Cells(1, 1), Cells(LR, LC)).Copy
        Wkb_1.Activate
        Osht.Select

        Osht.Range("A1").PasteSpecial
        Application.CutCopyMode = False

   ' Osht.Range("O:O").EntireColumn.Delete
    Osht.Range("R:V").EntireColumn.Delete
    
    Osht.Range("C:C").EntireColumn.Delete
    
    Osht.Columns("F:F").Insert Shift:=xlToRight
    Osht.Range("F1") = "Section"
    Osht.Range("F2:F" & LR).Formula = "=VLOOKUP(G2,Mapping!A:B,2,0)"
    
    Osht.Columns("J:J").Insert Shift:=xlToRight
    Osht.Range("J1") = "Expense G/L"
    Osht.Range("J2:J" & LR).Formula = "=VLOOKUP(G2,Mapping!A:B,2,0)"
    
    Osht.Columns("P:V").Insert Shift:=xlToRight
    Osht.Range("P1") = "Vendor Code"
    Osht.Range("P2:P" & LR).Formula = "=VLOOKUP(G2,YFIINTDSRP!H:J,3,0)"
    
    Osht.Range("Q1") = "Vendor Name"
    Osht.Range("Q2:Q" & LR).Formula = "=VLOOKUP(G2,YFIINTDSRP!H:K,4,0)"
    
    Osht.Range("R1") = "Vendor PAN"
    Osht.Range("R2:R" & LR).Formula = "=VLOOKUP(G2,YFIINTDSRP!H:L,5,0)"
    
    Osht.Range("T2:T" & LR).Formula = "=LEFT(S2,4)"
    
    Osht.Range("U2:U" & LR).Formula = "=RIGHT(U2,1)"
    
    Osht.Range("V1") = "WHT Base Amount"
    
    Osht.Range("W1") = "Amount in local curre ncy As per GL"
    
    Osht.Range("Y1") = "Return TDS"
    Osht.Range("Z1") = "Return rateS"
    
    Osht.Range("Z2:Z" & LR).Formula = "=Y2/W2*100"
    
    Osht.Range("AA1") = "RPU Base"
    Osht.Range("AA2:AA" & LR).Formula = "=-W2"
    
    Osht.Range("AB1") = "RPU TDS"
    Osht.Range("AB2:AB" & LR).Formula = "=-Y2"
    
    'Osht.Range("R1") = "Vendor PAN"
    'Osht.Range("R2:R" & LR).Formula = "=VLOOKUP(H2,YFIINTDSRP!H:L,5,0)"
    
    Osht.Columns("A:A").Insert Shift:=xlToRight
    Osht.Range("A1") = "Working Remark"
    
    
    
    Osht.Range("AE1") = "Certifiacte"
    Osht.Range("AF1") = "Reason"
    Osht.Range("AG1") = "BSRCode"
    Osht.Range("AH1") = "Tender Date"
    Osht.Range("AI1") = "Challan Sn"
    Osht.Range("AJ1") = "SN"
    
    '-----------------------------------------------------------------
    '//Creating Output file
        Path = ThisWorkbook.Path
        
        Dim OWkb As Workbook
    
         Set OWkb = Workbooks.Add
        
        File_Name = Autosht.Range("D8")
        
        Wkb_1.Sheets("Output File").Copy OWkb.Sheets(OWkb.Sheets.Count)

        OWkb.SaveAs Filename:=Path & "\" & File_Name, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        
        OWkb.Activate: OWkb.Sheets("Output File").Range("A1").Select: OWkb.Save: Windows(File_Name).Close
End Sub

【问题讨论】：

宏作品的大小是否会导致特定问题？无论如何，请考虑将工作簿设置为插件并将您的文件合并到一个新工作簿中。
您如何确定您正在处理的目录中包含与 "*Report*.xls" 完全匹配的 3 个文件？
ws_Data.Cells.Copy - 你在这里复制整个工作表：只复制占用的单元格会更整洁。找到最后使用的行和列，并仅复制到该点。

标签： excel vba excel-formula excel-2010

【解决方案1】：

为每张纸尝试清洁过程。

从最后编辑的列到结束列（向右）。选择并删除所有列（Ctrl + '-'）从最后编辑的行到最后一行（向底部）。选择并删除所有行（Ctrl + '-'）

【讨论】：

【解决方案2】：

关于“宏文件大小”：除了建议之外没有其他答案：

从“大”宏工作簿中导出模块
创建一个全新的工作簿
将步骤 1 中的文件导入新工作簿。

新的工作簿会更小。如果每次运行代码时它都会增长 - 那么这就是您可以开始找出问题的地方。只运行部分代码，直到您可以检测到哪些代码正在改变文件大小。

您的下一个问题是如何找到缓慢或冗长的操作。这可以通过如下代码完成：

Dim timeDuration As Variant
Dim timeStart As Variant
Dim timeEnd As Varient

timeStart = Timer

'Call a function or subroutine

timeEnd = Timer

Debug.Print "<Method Name> duration: " & CStr(timeEnd - timeStart)

在Immediate 窗口中评估结果

或者，您可以将代码放在每个方法中，然后在方法顶部抓取timeStart，在底部抓取timeEnd。

这里有帮助的是将代码分组为上述代码可以围绕的重点方法。提供的代码有 4 种方法...所以这将是要查看的第一组结果 - 然后从那里继续。

由于编码风格的原因，评估代码比需要的更难。一些建议供您考虑：

选项显式

很少有 VBA 指南属于始终类别，但这是其中之一：

总是在您在 VBA 中创建的任何模块的顶部声明 Option Explicit。 Option Explicit 强制开发人员在模块中使用它们之前显式声明所有变量、常量和字段。

在提供的代码顶部声明 Option Explicit 并调用“调试 -> 编译 VBA 项目”将识别 44 个使用但从未声明的局部变量和两个阻止发布代码编译的子例程（我假设子程序存在于另一个模块中......只是不是发布的那个）。

（建议）Visual Basice 编辑器 (VBE) 将通过选中“工具 -> 选项... -> 要求变量声明”自动将 Option Explicit 放置在新模块的顶部。

使用有意义的名称

所有开发人员都花更多时间阅读代码而不是编写代码。因此，代码具有易于解释为内容和功能的变量名是极其重要的。在积极编写代码时，很容易知道/记住诸如LR 和/或LC 之类的变量意思。远离代码 24 小时（或在 SO 问题上第一次阅读）......但事实并非如此。

标准笑话是：计算机科学中有 2 个难题：缓存失效、命名事物和非 1 错误。“命名事物”使列表强调了它的重要性（和困难）。长名称不会减慢您的代码速度...使用更长/描述性的名称让您的生活更轻松。

（建议）使用至少三个字符的名称，但最好使用能传达某种含义的完整单词。从第一次审阅者的角度考虑名称。

管理变量范围

这与使用Option Explicit 有关。 VBA 中有 3 个变量作用域：Global、Module 和 Local。此代码中的一些变量名称在多个子例程中重复/使用。这些变量应该在模块的顶部（Module Scope）显式声明。

看看变量Wkb_1是如何使用的。它在Macro_Step_1 中声明，但在接下来的 3 个子例程中使用（没有声明）。它是Macro_Step_1 中的Workbook 对象（通过声明），但在所有后续使用中都是Variant，因为它没有显式声明。此外，它被分配了全局ThisWorkbook 对象。直接使用ThisWorkbook，可以删除Wkb_1。并且，与“使用有意义的名称”相关，使用Wkb_1 掩盖了它代表ThisWorkbook 对象的事实（在程序的后面）。 wkbpath = ThisWorkbook.Path 比wkbpath = Wkb_1.Path 清晰得多。

（建议）检查所有变量的范围并在适当的位置声明它们。

不要重复自己（DRY）

如果您发现自己的工作流程是“复制 - 粘贴 - 更改字符串”，那么是时候考虑如何在过程中捕获代码了。这将使您的代码更易于阅读、理解，并且有时...更快，具体取决于所涉及的操作。

代码

Tempsht.Columns("D:D").TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True

使用上述工作流程创建了 6 次。复制代码的整面墙可以替换为：

    GiveThisOperationAName "D", "F", "J", "M", "Q", "U"

GiveThisOperationAName 在哪里：

Private Sub GiveThisOperationAName(ParamArray columnLetters() As Variant)
    
    Dim tempWorksheet As Worksheet
    Set tempWorksheet = ThisWorkbook.Sheets("Temp")
    
    Dim columnLetter As Variant
    For Each columnLetter In columnLetters
        tempWorksheet.Columns(columnLetter & ":" & columnLetter).TextToColumns _
        Destination:=Range(columnLetter & "1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Next
End Sub

（建议）还有其他类似的机会领域。删除重复项将使您的代码更易于阅读/理解，更易于维护/修改，并且更易于进行性能测试。

【讨论】：