如何最大程度地减少访问XLSM文件的时间

Question

我有一个宏，可以访问某些XLSM文件以检索电子表格并将其粘贴为值。但是，宏需要大量时间开放 - 主要是因为打开每个XLSM文件需要很多时间。有什么办法可以减少此加载时间？

这是我拥有的代码：

Option Explicit
Sub GetSheets()
Dim Path As String
Dim Filename As String
Dim wbMaster As Workbook
Dim wbActive As Workbook
Dim wsPanel As Worksheet
Set wbMaster = ThisWorkbook
Path = "C:UsersAdminPMOTest consolidationIndependent files"
If Right$(Path, 1) <> "" Then Path = Path & ""
Filename = Dir(Path & "*.xlsm")
Dim wsname As String
clean
Do While Filename <> ""
    Set wbActive = Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True)
    'Workbook_Opn_DisableMacros (Path & Filename)
    With wbActive
        If Evaluate("ISREF('" & "Panel" & "'!A1)") Then 'Rory 'https://stackoverflow.com/questions/6688131/test-or-check-if-sheet-exists
            Set wsPanel = wbActive.Worksheets("Panel")
            wsPanel.Copy After:=wbMaster.Worksheets(1)
            If Not IsEmpty(wsPanel.Range("U5")) Then
                ActiveSheet.Name = wsPanel.Range("U5")
                Cells.Select
                Range("B3").Activate
                Selection.Copy
                Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, 
                Operation:=xlNone _
                , SkipBlanks:=False, Transpose:=False
                Selection.PasteSpecial Paste:=xlPasteValues, 
                Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                Application.CutCopyMode = False
                ActiveSheet.Visible = False
            Else
                MsgBox "Missing value to rename worksheet in " & Filename
            End If
        End If
    End With
    wbActive.Close
    Filename = Dir()
    Loop
End Sub

快速搜索，我发现了这个代码显然解决了此问题，但一直在崩溃。

Public Sub Workbook_Opn_DisableMacros(FileComplete As String)
Dim oldSecurity
oldSecurity = Excel.Application.AutomationSecurity
Excel.Application.AutomationSecurity = msoAutomationSecurityForceDisable
Excel.Workbooks.Open (FileComplete), ReadOnly:=True
Excel.Application.AutomationSecurity = oldSecurity
End Sub

有人知道如何将此解决方案合并到我的代码中吗？任何帮助将得到深深的赞赏。谢谢！

Answer 1

您的代码在这里：

            Cells.Select
            Range("B3").Activate
            Selection.Copy
            Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, 
            Operation:=xlNone _
            , SkipBlanks:=False, Transpose:=False
            Selection.PasteSpecial Paste:=xlPasteValues, 
            Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            Application.CutCopyMode = False
            ActiveSheet.Visible = False

是不必要的。首先，您正在选择ActivesHeet中的所有单元格 - 数百万。然后，您无目的激活一个单元格，然后复制几百万个单元格，将它们粘贴到顶部，然后再进行一次，然后隐藏纸张。我不知道您为什么要这样做，但是您可以通过这样做来实现相同的目的：

   With Activesheet
        .usedrange.formula = .usedrange.value
        .visible = false
   End With

应该加快速度