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:\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

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

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

是不必要的。首先，您要选择活动表中的所有单元格 - 这是几百万。然后你激活一个单元格没有任何意义，然后你复制那几百万个单元格，将它们作为值粘贴到顶部，然后再次执行，然后隐藏工作表。我不知道你为什么要这样做，但你可以通过以下方式达到同样目的：

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

应该加快速度

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

1 个答案: