VBA - объединение данных из 100 и более одинаковых листов с переменным количеством строк в один консолидированный лист

Question

Я в значительной степени самоучка для пользователя vba, но мне всегда удавалось собрать то, что мне нужно, из вопросов на этом сайте или аналогичных, но на этот раз я поставил в тупик, поэтому любая помощь получила большую помощь.

Я написал несколько VBA, чтобы собрать данные из 100 нечетных файлов Excel с одинаковым исходным листом (хранящимся в нескольких разных папках) в один консолидированный лист в отдельной рабочей книге.Число столбцов является постоянным (84), но количество строк в исходных листах является переменным (также содержит формулы, поэтому не должно подсчитывать строки, содержащие формулу, возвращающую ""), и я хочу, чтобы на консолидированном листе были все записи из каждого файла без пробелов.

Я написал что-то, что работает, но ужасно медленно, и я чувствую, что проблема заключается в том, что я в основном определяю каждую ячейку для очистки, что является большим количеством записей, когда я хочу идентифицировать диапазон с переменными (началоrow (всегда 5) в Last Row (переменная) и за один раз перебираемся на лист консолидации, единственной переменной назначения является следующая доступная строка, прежде чем перейти к следующему файлу, но мои попытки адаптировать код для этого получаютвыкидывать ошибки.

Sub Test_Macro()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim fso, oFolder, oSubfolder, oFole, queue As Collection
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set queue = New Collection
    queue.Add fso.GetFolder("D:\Example\Example")
    '^^^ UPDATE THIS FILE PATH TO FOLDER WHERE THE RETURNED SCORECARDS ARE STORED. IF FOLDERS STORED IN MULTIPLE FOLDERS THIS SHOULD BE THE FOLDER CONTAINING SUBFOLDERS ^^^

    Do While queue.Count > 0
        Set oFolder = queue(1)
        queue.Remove 1 'dequeue
        For Each oSubfolder In oFolder.SubFolders
            queue.Add oSubfolder
        Next oSubfolder
        For Each oFile In oFolder.Files

            y = ThisWorkbook.Sheets("Consol").Cells(Rows.Count, 1).End(xlUp).Row + 1 '<<< Finds next available row after a value in consol sheet

            Set wb = Workbooks.Open(oFile.path) '<<< Sets variable to the open performance scorecard
            Set ws = wb.Sheets("Detailed Summary") '<<< Defines sheet in the open scorecard to scrape from

            wb.Unprotect "Password"
            ws.Unprotect "Password"

            wsLR = ws.Columns("B").Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row '<<< Defines the range containing data in the open scorecard

            For x = 5 To wsLR 
                ThisWorkbook.Sheets("Consol").Cells(y, 1) = ws.Cells(x, 2)
                ThisWorkbook.Sheets("Consol").Cells(y, 2) = ws.Cells(x, 3)
                ThisWorkbook.Sheets("Consol").Cells(y, 3) = ws.Cells(x, 4) 'etc. imagine going on to...
                ThisWorkbook.Sheets("Consol").Cells(y, 84) = ws.Cells(x, 85)

                y = y + 1
            Next x

            wb.Close (Saved = False)
        Next oFile
    Loop

End Sub

Любая помощь, делающая то же самое, но быстрее, будет потрясающей! Спасибо

Answer 1

Некоторые комментарии, которые могут помочь ускорить, если предположить, что замедление находится на листе доступа:

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

Используйте ключевое слово after для надежности

wsLR = ws.Columns("B").Find("*", after:=ws.cells(1,2), SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row '<<< Defines the range containing data in the open scorecard

Считайте диапазон в массив VBA, а затем запишите в лист "Consol".Примерно так:

Dim scraped As Variant
With ws
    scraped = .Range(.Cells(5, 2), .Cells(wsLR, 85))
End With

Dim consolRng As Range
Set consolRng = ThisWorkbook.Sheets("Consol").Cells(y, 1)

Set consolRng = consolRng.Resize(rowsize:=UBound(scraped, 1), columnsize:=UBound(scraped, 2))
consolRng = scraped

Возможно, вы сможете еще больше ускорить процесс, объединив все рабочие книги в один массив VBA, а затем записав всю вещь как одну операцию вместо нескольких операций записи.(по одному на каждую книгу), подразумеваемый приведенным выше кодом, но это может быть более сложным и более подверженным проблемам с памятью в зависимости от размера данных.

Еще одно потенциальное замедление - использование FileSystemObject для сбора именжелаемых файлов.Это можно сделать быстрее, обратившись к командной строке и используя команду DIR.