Объединение разных листов в основной лист Excel

Question

Я действительно новичок в VBA, и я недавно изучал основы и язык VBA на Youtube и в подобных сообществах. Поэтому любая помощь будет очень признательна!

Я пытаюсь объединить рабочие листы Excel из разных книг Excel в основную книгу Excel. Все книги Excel находятся в одном файле. Однако они названы по-другому, и у меня есть только частичные имена для книг Excel, например «ABG_RSPB_xxxxx-yyyy».

У меня будет основная книга в папке, в которой будут собраны данные из всех разных книг и листов. Каждая книга, из которой извлекаются данные, имеет только один лист, и шаблон на каждом листе одинаковый. У них такие же заголовки. Все книги имеют формат csv. Однако рабочие листы также имеют частичные имена (рабочий лист будет иметь то же имя, что и книга, в которой он находится).

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

Мы будем глубоко признательны за любую помощь по изменению макроса, позволяющему извлекать его из неполных рабочих книг и листов. Спасибо!

Текущий код:

Sub consolidation ()

Set mainWB = ActiveWorkbook 
Dim mainPath As String
mainPath = ThisWorkbook.Path
Dim mainRowstart As Integer
mainRowstart = 2
Dim mainRC As Integer
mainRC = lastRow ("Consolidated Trades", "A") + 1

If mainRC < mainRowStart Then
        mainRC = mainRowStart
EndIf

Dim fso As Object
Dim folder As Object
Dim files As Object
Set fso = CreateObject ("Scripting.FileSystemObject")
Set folderPaths = fso.getfolder (mainPath)
set filePaths = folderPath.files

Dim curFile As String
Dim curPath As String
Dim curRC As Integer
Dim curWSName As String
curWSName = ""

For Each filePath In filePaths
        curPath = filePath
        curFile = Split (curPath, "\")(UBound(Split(curPath, "\")))

                    If Left (curFile, 1) <> "~" Then
                            If curFile <> "ABG_RSPB_xxxxx=yyy.csv" Then 
                                    If Right (curFile, Len ("ABG_RSPB_xxxxx=yyy.xlsm")) =                                                                                 "ABG_RSPB_xxxxx=yyy.xlsm" Or _ Right (curFile, Len("ABG_RSPB_xxxxx=yyy.xls")) = "ABG_RSPB_xxxxx=yyy.xls" Then 

            Workbooks.Open Filename: = curPath
            Workbooks (curFile).Activate

            For Each ws In Worksheets 
            If ws.Name = "ABG_RSPB_xxxxx=yyy.csv" Then
                    curWSName = ws.Name
            End If

    Next Ws

            curRC = lastRow(CurWSName, "A")
            mainWB.Activate
            mainRC = lastrow("Consolidated Trades", "A") + 1

    If curRC >= 2 Then

            mainWB.Worksheets("Consolidated Trades").Range("A" & mainRC & ":U: & mainRC + curRC - 2).Value = _ Workbooks(curFile).Worksheets(curWSName).Range("A2:U" & curRC).Value

            mainWB.Worksheets("Consolidated Trades").Range("V" & mainRC).Value = curFile & "with" & curRC -1 & "Rows of Data"

            EndIf

            Workbooks(curFile).Close

            EndIf
        EndIf
      EndIf
    NextfilePath

MsgBox "Process Complete"
End Sub

Answer 1

Если я вас правильно понял, у вас есть несколько файлов CSV, помимо вашей основной книги, и вы хотите перебрать все файлы CSV и прочитать все значения в первом столбце первого листа каждого файла, а затем записать их в первый столбец основной книги, верно? Я предположил, что:

1. все файлы csv желательны и должны быть прочитаны (т. Е. Нет файла csv, который вы бы не хотели читать)
2. У вас есть подпрограмма под названием "lastrow", которая находит последнюю строку в столбце листа

Пожалуйста, посмотрите, правильно ли выполняет следующий код задание. Если возникнут проблемы, оставьте комментарий ниже, я увижу и отредактирую свой код, как вы хотите.

Sub consolidation()

    Dim mainRowstart As Integer
    mainRowstart = 2
    Dim mainRC As Integer
    mainRC = lastrow("Consolidated Trades", "A") + 1 'I've assumed that you have another sub called "lastrow"
    If mainRC < mainRowstart Then
            mainRC = mainRowstart
    End If

    '======================================================================================================
    '   1- Get all csv files in this workbook's path
    '======================================================================================================
    Dim allCsvFiles() As Variant
    allCsvFiles = GetFileList(ThisWorkbook.path, "csv")

    '======================================================================================================
    '   2- Loop over and read/write all data
    '======================================================================================================
    If IsArray(allCsvFiles) Then 'i.e., at least one file has found

        Dim file As Variant
        For Each file In allCsvFiles

            'Open file
            Workbooks.Open (file)

            'Activate
            Workbooks(file).Activate


            'How many rows do exist in the file?
            Dim curRC As Integer
            curRC = lastrow(Workbooks(file).Sheets(1).Name, "A") 'Hint: as the file is a "csv" file, it always contains only one sheet and there is no need to search and find a specific sheet

            If curRC > 2 Then

                mainRC = lastrow("Consolidated Trades", "A") + 1 'Is it required to run this function in every iteration???

                ThisWorkbook.Worksheets("Consolidated Trades").Range("V" & mainRC).Value = file & " with " & curRC - 1 & " rows of data"


                'Read and write data
                Dim row As Integer
                For row = 2 To curRC

                    ThisWorkbook.Worksheets("Consolidated Trades").Cells(mainRC, 1).Value = Workbooks(file).Sheets(1).Cells(row, 1).Value
                    mainRC = mainRC + 1

                Next row
            End If

            'Close file
            Workbooks(file).Close False

        Next

        MsgBox "Process Complete"

    End If   

End Sub

где GetFileList это:

Function GetFileList(path As String, FileSpec As String) As Variant

    Dim FileArray() As Variant
    Dim FileCount As Integer
    Dim FileName As String

    FileCount = 0
    FileName = Dir(path & "\*." & FileSpec)
    If FileName = "" Then GoTo NoFilesFound

'   Loop until no more matching files are found
    Do While FileName <> ""
        FileCount = FileCount + 1
        ReDim Preserve FileArray(1 To FileCount)

        FileArray(FileCount) = FileName
        FileName = Dir()
    Loop
    GetFileList = FileArray
    Exit Function

NoFilesFound:
    GetFileList = False
End Function