Копирование данных из рабочих книг в текущую рабочую книгу очень медленно в одном файле по сравнению с другими

Question

У меня есть код для загрузки данных из любого количества рабочих книг, которые мы выбираем и загружаем в текущую рабочую книгу. Он прекрасно работает в отдельности (в файле, где я не выполняю никаких других задач). Тем не менее, когда я использовал этот код в большом файле, где я использую (ссылки) скопированные данные в ряде функций массива, это заняло более двадцати минут, чтобы загрузить 1-2 файла по сравнению с секундами ранее.

Возможно ли это медленно из-за ссылок на другие вкладки с функциями? Я что-то пропустил. Любая помощь будет оценена.

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
Application.Calculation = xlCalculationManual

Number = 0
IT = 0
Set thisWb = ActiveWorkbook
Set ws = thisWb.Sheets("CF")
thisWb.Sheets("CF").Select
ws.Range(ws.Cells(2, 1), ws.Cells(100000, 42)).ClearContents

Do
    files = Application.GetOpenFilename(filefilter:="Excel workbooks (*.csv*),*.csv*", Title:="Select files to import", MultiSelect:=True)
    If Not IsArray(files) Then Exit Sub 'Cancel must have been clicked
    If UBound(files) < 1 Then
        MsgBox "You have not selected any file. Please select files."
        End If
Loop Until UBound(files) > 0

 Number = UBound(files)
 N = Number + N

 For IT = 1 To UBound(files)
    Workbooks.Open files(IT)
    With ActiveWorkbook
        Application.CutCopyMode = False
        Set wk = ActiveWorkbook.ActiveSheet
        .ActiveSheet.Range("A2:AP10000").Copy
        'LastRow = wk.Cells(Rows.Count, "A").End(xlUp).Row
        thisWb.Activate
        ws.Select
        LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
        Range("A" & LastRow).Select
        Set Rng = ws.Range("A" & LastRow)
        Rng.PasteSpecial xlPasteValues
        LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
        Application.CutCopyMode = False
        .Close False
   End With
Next

Все, что может заставить этот код работать быстрее, например, загрузка 3-4 маленьких файлов за минуту, будет идеальным.

Answer 1

Вот пример того, как создавать переменные и объекты, чтобы отслеживать, какую рабочую книгу, рабочую таблицу и источник данных вы используете.Также обратите внимание, что я копирую данные из Range в массив на основе памяти для тонн скорость .

Обратите также внимание, что рекомендуется очень всегда используйте Option Explicit.

Option Explicit

Sub test()
    Dim number As Long
    Dim it As Long
    number = 0
    it = 0

    Dim thisWB As Workbook
    Dim ws As Worksheet
    Set thisWB = ActiveWorkbook
    Set ws = thisWB.Sheets("CF")

    '--- clear the worksheet
    ws.Cells.Clear

    Dim files As Variant
    Do
        files = Application.GetOpenFilename(filefilter:="Excel workbooks (*.csv*),*.csv*", _
                                            Title:="Select files to import", _
                                            MultiSelect:=True)
        If Not IsArray(files) Then Exit Sub      'Cancel must have been clicked
        If UBound(files) < 1 Then
            MsgBox "You have not selected any file. Please select files."
        End If
    Loop Until UBound(files) > 0

    Dim n As Long
    number = UBound(files)

    Dim csvWB As Workbook
    Dim csvWS As Worksheet
    Dim csvData As Variant
    Dim dataRange As Range
    Dim lastRow As Long
    Dim rng As Range
    For it = 1 To UBound(files)
        Set csvWB = Workbooks.Open(files(it))
        With csvWB
            Set csvWS = csvWB.Sheets(1)
            csvData = csvWS.UsedRange                   'copy to memory-based array
            'Set csvData = csvWS.Range("A2:AP10000")    'copy to memory-based array
            Set dataRange = ws.Range("A1").Resize(UBound(csvData, 1), UBound(csvData, 2))
            dataRange.Value = csvData
            .Close False
        End With
    Next
End Sub