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

我的代码是：

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文件。

这段代码（从：

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

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

下面是一个可能适合您的实现

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的方法，因为我相信如果不使用Select，它会运行得更快。

这段代码（借用自：

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

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

下面是一个可能适合您的实现

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的方法，因为我相信如果不使用Select，它会运行得更快。

我不能100%确定在您的场景中这是否可行，但值得一试

该加载项将允许您合并包含特定名称以及每个文件的固定范围的文件。请尝试一下，看看您的情况如何

---

祝你好运！

根据你的场景，我不能100%确定这是否可行，但值得一试

该加载项将允许您合并包含特定名称以及每个文件的固定范围的文件。请尝试一下，看看您的情况如何

---

祝你好运！

尝试使用此工作簿的

。工作表（“Obliczenia”）。范围（“E1:E210”）。偏移量（0，i）

，然后在下面几行中

.Formula=Source

和

.Value=.Value

半秒钟！非常感谢！我已经编辑了您的答案@ShaiRado，删除了select。注意，我还没有测试过它，但看不出它不起作用的原因。只需直接在范围上操作，而不在其间选择它！用ThisWorkb尝试

ook.工作表（“Obliczenia”）.范围（“E1:E210”）.偏移量（0，i）

，然后在下面几行中

.Formula=Source

和

.Value=.Value

半秒！非常感谢！我已经编辑了您的答案@ShaiRado，以删除选择。注意，我还没有测试过这个，但看不出它不起作用的原因。只需直接在范围上操作，而不在其间选择它！问题已经解决了问题是关于VBA而不是关于插件的。问题在很久以前就解决了。问题是关于VBA而不是关于插件的。