从许多工作簿复制范围而不打开文件

我的代码是：

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是给定的文件path。 所有的文件被命名为U1.xlsx，…，U102.xlsx我想从这些文件中复制相同的范围。 但是，上述机制非常缓慢，因为102个文件需要47秒。 我想这个工作，例如1000个文件，因此我正在寻找一种方法来加快我的macros。

我应该改变做什么？ 最好我会满意这个代码的执行时间低于10秒。 有没有可能读取一个封闭的文件，或者可能以某种方式使用VBA数组呢？

一般来说，我正在寻找一个快速的algorithm来处理大量的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，因为我敢肯定，没有这个可能会更快。

Answer 2

我不是100％确定这将适用于您的情况，但值得一试。

http://www.rondebruin.nl/win/addins/rdbmerge.htm

AddIn将允许您合并包含某些名称以及每个文件的固定范围的文件。 试一试，看看你是如何相处的。

祝你好运！