☰

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

tag-icon • tag-icon microsoft-excel merge
如何合并数百个 Excel 电子表格文件？

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

虽然每个文件的结构相同，但工作表 1 和 2 之间的列数（和标题名称）不同（例如）。因此，无法将所有内容合并到一个文件中，将所有内容放在一张工作表中！

有两个复杂因素：

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

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

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

答案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 的行都不会复制到主表
  • 额外列中只需要文件名（而不是文件路径）
  • 如果某些工作表中没有任何数据（或者只是填充了零），我不知道它会如何工作

希望这可以帮助。

答案2

还值得一提的是，Ron de Bruin 创建了一个非常棒的 Windows 插件，用于合并 Excel 工作表，名为 RDBMerge。说明可在此处找到：http://www.rondebruin.nl/merge.htm。它对我来说非常完美，可以在 Excel 2007 中合并 xlsx 文件。

它确实在合并文件中创建了一个额外的列，其中包含源文件的名称。不过，不确定它如何处理零数据条目（原始问题的第二部分）。

答案3

这是一个不错的项目，但非常可行。这是您可以构建的 VBA 的一个良好开端。如果您将需要合并的所有文件（单独）放在一个文件夹中，这将允许您浏览它们。您要合并到的主工作簿不应位于此目录中。

Option Explicit
Sub giantmerge()
    Dim f As Object, fso As Object
    Dim folder As String
    Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
    Dim sn1 As String, sn2 As String, sn3 As String, sn4 As String
    Set wb = ThisWorkbook
    'Change sheet names to match those in your workbooks.
    sn1 = "Sheet1"
    sn2 = "Sheet2"
    sn3 = "Sheet3"
    sn4 = "Sheet4"
    Set ws1 = wb.Sheets(sn1)
    Set ws2 = wb.Sheets(sn2)
    Set ws3 = wb.Sheets(sn3)
    Set ws4 = wb.Sheets(sn4)

    Set fso = CreateObject("Scripting.FileSystemObject")
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        If .SelectedItems.Count = 0 Then
            MsgBox "Cancel Selected"
            End
        End If
        folder = .SelectedItems(1)
    End With
    For Each f In fso.GetFolder(folder).Files
        Workbooks.Open Filename:=f.Path
        'Get data and store in temporary arrays.
        Workbooks(f.Name).Close
        'Input data in this workbook (master).
    Next
End Sub

现在，您（或其他人）可以在最后提供 For 循环的代码。希望这能有所帮助。

答案4

使用简单的 python 脚本的方法（比 VB 短得多！）。

https://superuser.com/a/1138948/141182

相关内容