我如何最小化访问xlsm文件的时间？

我有一个macros访问一些xlsm文件来检索电子表格并将其粘贴为值。 但是，macros需要花费很多时间才能打开 – 主要是因为打开每个xlsm文件需要很多时间。 有什么办法可以减less这个加载时间吗？

这是我有的代码：

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:\Users\Admin\PMO\Test consolidation\Independent 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 

做一个快速search，我发现这个代码，显然解决了这个问题，但一直在崩溃我的文件。

 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 

有谁知道如何将这个解决scheme合并到我的代码？ 任何帮助深表谢意。 谢谢！

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 

是不必要的。 首先，你要selectactivesheet中的所有单元格 – 这是几百万。 然后，您激活一个单元格，然后复制这些数百万个单元格，将它们粘贴到顶部作为值，然后重新执行，然后隐藏表单。 我不知道你为什么要这样做，但是你可以通过做同样的事情来达到目的：

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

这应该加快速度