将多个 Excel 个工作簿合并为一个

Question

更新：

下面附上了我在 joinedupdata.com 上找到的示例 VBA 代码。我需要帮助进行两项修改：(1) 删除重复的 header 行被删除的条件，以及 (2) 查看是否有办法通过中的空白行将每个 Excel 文件中的串联数据分开在 left-most 单元格中具有以下 table 文件名的组合 sheet。

Dim firstRowHeaders As Boolean
Dim fso As Object
Dim dir As Object
Dim filename As Variant
Dim wb As Workbook
Dim s As Sheet1
Dim thisSheet As Sheet1
Dim lastUsedRow As Range
Dim file As String

On Error GoTo ErrMsg

Application.ScreenUpdating = False
firstRowHeaders = True 'Change from True to False if there are no headers in the first row

Set fso = CreateObject("Scripting.FileSystemObject")

'PLEASE NOTE: Change <<Full path to your Excel files folder>> to the path to the folder containing your Excel files to merge
Set dir = fso.Getfolder("<<Full path to your Excel files folder>>")

Set thisSheet = ThisWorkbook.ActiveSheet

For Each filename In dir.Files
    'Open the spreadsheet in ReadOnly mode
    Set wb = Application.Workbooks.Open(filename, ReadOnly:=True)

    'Copy the used range (i.e. cells with data) from the opened spreadsheet
    If firstRowHeaders And i > 0 Then 'Only include headers from the first spreadsheet
        Dim mr As Integer
        mr = wb.ActiveSheet.UsedRange.Rows.Count
        wb.ActiveSheet.UsedRange.Offset(1, 0).Resize(mr - 1).Copy
    Else
        wb.ActiveSheet.UsedRange.Copy
    End If

     'Paste after the last used cell in the master spreadsheet
    If Application.Version < "12.0" Then 'Excel 2007 introduced more rows
        Set lastUsedRow = thisSheet.Range("A65536").End(xlUp)
    Else
        Set lastUsedRow = thisSheet.Range("A1048576").End(xlUp)
    End If

    'Only offset by 1 if there are current rows with data in them
    If thisSheet.UsedRange.Rows.Count > 1 Or Application.CountA(thisSheet.Rows(1)) Then
        Set lastUsedRow = lastUsedRow.Offset(1, 0)
    End If
    lastUsedRow.PasteSpecial
    Application.CutCopyMode = False
Next filename

ThisWorkbook.Save
Set wb = Nothing

#If Mac Then
    'Do nothing. Closing workbooks fails on Mac for some reason
#Else
    'Close the workbooks except this one
    For Each filename In dir.Files
        file = Right(filename, Len(filename) - InStrRev(filename, Application.PathSeparator, , 1))
        Workbooks(file).Close SaveChanges:=False
    Next filename
    #End If

    Application.ScreenUpdating = True
    ErrMsg:
    If Err.Number <> 0 Then
    MsgBox "There was an error. Please try again. [" & Err.Description & "]"
    End If

我一直在尝试（但没有成功）找到一种方法将多个 Excel spreadsheet 合并为一个。我正在使用 MATLAB 分析实验数据。一打 Excel 传播 sheet 进去，等量出来。

传播sheet结构:

每个 Excel 文件中的数据仅在第一个 sheet (Sheet 1).

每个 sheet 有四列数据（有 headers）和下面可变数量的数据行。

每个 Excel 文件都有一个唯一的文件名。

例子:

Header 1 | Header 2 | Header 3 | Header 4
1111       22222      3333       4444
11122      11223      33344      33444
etc        etc        etc        etc

首选合并行为:

1) 多个 Excel 文件合并为一个 sheet 在一个新的传播sheet.

2) 列 header 在合并过程中得到维护。

3) 与其将每个连续的数据集添加到前一个数据集的底部（"vertical" 添加），不如将列放置 side-by-side（"horizontal" 添加）和 one-column 中断 in-between.

4) 每个原始文件的文件名放在第一列正上方的一行中 header.

5) 最好是cross-platform (Windows/Mac OS X)。但是，如果 VBA 和 ActiveX 是唯一的方法，那也很好。

样本输出:

Filename1                                     Filename2                
Header 1 | Header 2 | Header 3 | Header 4     Header 1 | Header 2 | Header 3 | ...
111        22222      33333      4444         1111        222222    44444
Data...    Data...    Data...    Data...      Data...     Data...   Data...

Answer 1

通过与主工作簿位于同一文件夹中的工作簿进行简单循环就足够了。

Sub collect_wb_data()
    Dim wbm As Workbook, wb As Workbook
    Dim fp As String, fn As String, nc As Long

    'Application.ScreenUpdating = False
    Set wbm = ThisWorkbook
    With wbm.Worksheets("sheet1")   'set this properly to the receiving worksheet in the master workbook

        fp = wbm.Path
        fn = "*.xl*"
        fn = Dir(fp & Chr(92) & fn)

        Do While CBool(Len(fn))
            If Not fn = .Parent.Name Then
                Set wb = Workbooks.Open(Filename:=fp & Chr(92) & fn, _
                                        UpdateLinks:=False, _
                                        ReadOnly:=True)
                nc = nc + 1
                .Cells(1, nc) = Left(fn, InStr(1, fn, Chr(46)) - 1)
                wb.Worksheets(1).Cells(1, 1).CurrentRegion.Copy Destination:=.Cells(2, nc)
                wb.Close SaveChanges:=False
                Set wb = Nothing
                nc = .Cells(2, Columns.Count).End(xlToLeft).Offset(0, 1).Column
            End If
            fn = Dir
        Loop

        '.parent.save   'Uncomment to save before finishing operation
    End With

    Set wbm = Nothing
    Application.ScreenUpdating = True

End Sub

奇怪的是，很少有人提到要处理的工作簿列表是如何导出的。我在主工作簿所在的同一文件夹上使用了一个简单的文件掩码，但我让它很容易更改。如果要处理特定文件，则可以从标准文件打开对话框创建多个列表。硬编码的工作簿名称数组是另一种选择。

我留下了一些命令（例如禁用屏幕更新、完成前保存）注释掉了。一旦您对这些方法感到满意，您可能想取消注释这些。

将多个 Excel 个工作簿合并为一个

Combine multiple Excel workbooks into one

excel

matlab

vba

concatenation