vba - 在不打开文件的情况下从多个工作簿复制范围

Question

我的代码是:

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Wiersz = 102
For i = 1 To Wiersz
    Workbooks.Open FileName:=Katalog & "U" & i & ".xlsx", ReadOnly:=True


    Range("D11:D210").Copy
    ThisWorkbook.Worksheets("Obliczenia").Range("E1:E200").Offset(0, i).PasteSpecial xlPasteValues


    Workbooks("U" & i & ".xlsx").Close
Next i
Application.DisplayAlerts = True
Application.ScreenUpdating = True

其中 Katalog 是给定的文件路径。所有文件都命名为 U1.xlsx, ...,U102.xlsx
我想从每个文件中复制相同的范围。然而，上面的机制非常慢，因为 102 个文件需要 47 秒。我希望这可以用于例如1000 个文件，因此我正在寻找一种方法来加速我的宏。

我应该改变什么来做到这一点？最好我会对此代码的执行时间低于 10 秒感到满意。是否有可能读取已关闭的文件，或者可能以某种方式使用 VBA 数组？

一般来说，我正在寻找一种快速算法来处理大量 xlsx 文件。

Answer 1

这段代码(借自 http://www.ozgrid.com/forum/showthread.php?t=155964 :

Sub GetRange() 
    With Range("A2:A20") 
        .Formula = "='C:\[Test.xlsx]Test'!D2:D20" 
        .Value = .Value 
    End With 
End Sub 

给出了如何从关闭的文件中提取范围的概念。我认为这种方法可以适用于你。

这是一个可能适合您的实现。

Sub GetRangesFromClosedWorkbooks()
    Dim Source As String
    Dim Wiersz As Integer
    Dim i As Integer

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    Wiersz = 102
    For i = 1 To Wiersz
        Source = "='C:\sql\[KatalogU" & i & ".xlsx]'!D1:D210"
        ThisWorkbook.Worksheets("Obliczenia").Range("E1:E210").Offset(0, i).Select
        With Selection
            .Formula = Source
            .Value = .Value
        End With
    Next i
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

希望有人可以向我们展示一种在不使用 Select 的情况下执行此操作的方法，因为我相信如果没有它它会更快。