如何合并数百个 Excel 电子表格文件？

Question

我有数百个格式相同的 excel 文件（即每个 Excel 文件 4 个工作表）。我需要将所有文件合并为 1 个所有歌舞文件，该文件必须与原始文件具有相同的格式（即维护四个单独的工作表，它们都具有相同的名称）。

虽然每个文件的结构都相同，但工作表 1 和工作表 2（例如）之间的列数（和标题名称）是不同的。所以它不能合并成一个文件，所有内容都在一张纸上！

有两个并发症：

1. 我需要在合并文件（在每个工作表上）中创建一个 EXTRA 列来标识源文件（“文件名”）。

2. 这些文件包含许多零数据条目（例如 55 行有用数据，后跟数百行零），我需要从合并文件中删除这些条目。

我从未使用过 VBA，但我想每个人都必须从某个地方开始。

Answer 1

这是您的一个强烈要求，但我有一个晚上要烧，所以这里有一些我认为可以工作的代码。（不知道您的工作表的格式无济于事，但我们可以从这里开始。）

打开一个新工作簿（这将是您的主工作簿），转到 VBA 环境（Alt + F11）并创建一个新模块（插入 > 模块）。将以下 VBA 代码粘贴到新模块窗口中：

Option Explicit
Const NUMBER_OF_SHEETS = 4

Public Sub GiantMerge()
    Dim externWorkbookFilepath As Variant
    Dim externWorkbook As Workbook
    Dim i As Long
    Dim mainLastEnd(1 To NUMBER_OF_SHEETS) As Range
    Dim mainCurEnd As Range

    Application.ScreenUpdating = False

    ' Initialise

    ' Correct number of sheets
    Application.DisplayAlerts = False
    If ThisWorkbook.Sheets.Count < NUMBER_OF_SHEETS Then
        ThisWorkbook.Sheets.Add Count:=NUMBER_OF_SHEETS - ThisWorkbook.Sheets.Count
    ElseIf ThisWorkbook.Sheets.Count > NUMBER_OF_SHEETS Then
        For i = ThisWorkbook.Sheets.Count To NUMBER_OF_SHEETS + 1 Step -1
            ThisWorkbook.Sheets(i).Delete
        Next i
    End If
    Application.DisplayAlerts = True

    For i = 1 To NUMBER_OF_SHEETS
        Set mainLastEnd(i) = GetTrueEnd(ThisWorkbook.Sheets(i))
    Next i


    ' Load the data
    For Each externWorkbookFilepath In GetWorkbooks()
        Set externWorkbook = Application.Workbooks.Open(externWorkbookFilepath, , True)

        For i = 1 To NUMBER_OF_SHEETS

            If mainLastEnd(i).Row > 1 Then
                ' There is data in the sheet

                ' Copy new data (skip headings)
                externWorkbook.Sheets(i).Range("A2:" & GetTrueEnd(externWorkbook.Sheets(i)).Address).Copy ThisWorkbook.Sheets(i).Cells(mainLastEnd(i).Row + 1, 1)

                ' Find the end column and row
                Set mainCurEnd = GetTrueEnd(ThisWorkbook.Sheets(i))
            Else
                ' No nata in sheet yet (prob very first run)

                ' Get correct sheet name from first file we check
                ThisWorkbook.Sheets(i).Name = externWorkbook.Sheets(i).Name

                ' Copy new data (with headings)
                externWorkbook.Sheets(i).Range("A1:" & GetTrueEnd(externWorkbook.Sheets(i)).Address).Copy ThisWorkbook.Sheets(i).Cells(mainLastEnd(i).Row, 1)

                ' Find the end column and row
                Set mainCurEnd = GetTrueEnd(ThisWorkbook.Sheets(i)).Offset(, 1)

                ' Add file name heading
                ThisWorkbook.Sheets(i).Cells(1, mainCurEnd.Column).Value = "File Name"
            End If

            ' Add file name into extra column
            ThisWorkbook.Sheets(i).Range(ThisWorkbook.Sheets(i).Cells(mainLastEnd(i).Row + 1, mainCurEnd.Column), mainCurEnd).Value = externWorkbook.Name

            Set mainLastEnd(i) = mainCurEnd
        Next i

        externWorkbook.Close
    Next externWorkbookFilepath

    Application.ScreenUpdating = True
End Sub

' Returns a collection of file paths, or an empty collection if the user selects cancel
Private Function GetWorkbooks() As Collection
    Dim fileNames As Variant
    Dim xlFile As Variant

    Set GetWorkbooks = New Collection

    fileNames = Application.GetOpenFilename(Title:="Please choose the files to merge", _
                                               FileFilter:="Excel Files, *.xls;*.xlsx", _
                                               MultiSelect:=True)
    If TypeName(fileNames) = "Variant()" Then
        For Each xlFile In fileNames
            GetWorkbooks.Add xlFile
        Next xlFile
    End If
End Function

' Finds the true end of the table (excluding unused columns/rows and rows filled with 0's)
Private Function GetTrueEnd(ws As Worksheet) As Range
    Dim lastRow As Long
    Dim lastCol As Long
    Dim r As Long
    Dim c As Long

    On Error Resume Next
    lastCol = ws.UsedRange.Find("*", , , xlPart, xlByColumns, xlPrevious).Column
    lastRow = ws.UsedRange.Find("*", , , xlPart, xlByRows, xlPrevious).Row
    On Error GoTo 0

    If lastCol <> 0 And lastRow <> 0 Then

        ' look back through the last rows of the table, looking for a non-zero value
        For r = lastRow To 1 Step -1
            For c = 1 To lastCol
                If ws.Cells(r, c).Text <> "" Then
                    If ws.Cells(r, c).Text <> 0 Then
                        Set GetTrueEnd = ws.Cells(r, lastCol)
                        Exit Function
                    End If
                End If
            Next c
        Next r
    End If

    Set GetTrueEnd = ws.Cells(1, 1)
End Function

保存它，我们就可以开始使用它了。

运行宏GiantMerge。您必须选择要合并的excel文件（您可以使用对话框选择多个文件，以通常的Windows方式（Ctrl选择多个单个文件，Shift选择一系列文件））。您不必在要合并的所有文件上运行宏，一次只可以对几个文件执行此操作。第一次运行它时，它会将您的主工作簿配置为具有正确数量的工作表，根据您选择合并的第一个工作簿命名工作表，并添加标题。

我做了以下假设（不是完整列表）：

• 有 4 张纸（这可以通过更改代码顶部的常量轻松更改。）
• 工作表在所有额外工作簿中的顺序相同
• 每个工作表中的列在所有工作簿中的顺序相同（尽管并非工作簿中的所有工作表都具有相同的列。例如，WorkBook1，Sheet1 具有 A、B、C 列，Sheet2 具有 A、B 列；WorkBook2、Sheet1有 A、B、C 列，Sheet2 有 A、B 列等。如果工作簿有以下内容：Sheet1 有 A、C、B 列，Sheet2 有 B、A 列，那么这些列将不会正确对齐）
• 额外工作簿中没有额外或缺失的列
• 每个工作簿的每个工作表中都有一个标题行（并且它仅在每个工作表的第一行中）
• 应包括所有列（即使它们只包含 0）
• 只包含 0 的表末尾的所有行都不会复制到主表
• 在额外的列中只需要文件名（而不是文件路径）
• 如果您在某些工作表中没有任何数据（或者它们只是用零填充），我不知道它会如何工作

希望这可以帮助。