关于Excel下通过VBA实现工作簿文件下工作表的合并

对于普通使用者而言，Excel是一个比较强大的数据处理工具。一般公司的普通职员常使用它来完成数据的录入分析，但是当面对处理经由多人按统一模板统计完成的录入数据分析时，数据将分散存放在多个.xlsx文件下，显然对这些文件一个一个分析不止费时费力，而且很大概率因数据重复，导致分析结果并不准确。因此在分析数据之前首先需要将多个.xlsx内的数据合并，再去除重复项，最后进行汇总分析才能得到相对准确的分析结果。但是手动复制粘贴多个工作表内容显得费时费力，也容易存在疏漏，尤其是当.xlsx文件众多，且内部sheet表众多时，重复劳动工作量大，出错率高。本文所描述的VBA程序正是为解决此问题而构建的。

一、首先考虑如何合并同一.xlsx文件下的多个sheet表

1、Excel文件解析

Excel是一个office下的一款可视化的数据处理工具，其文件命名为"****.xlsx"或"****.xls"，即每一个Excel文件的后缀名为".xlsx"或".xls"，新建一个Excel文件，内部默认存在3个Excel操作工作表。

在office自带的VBA编辑器下，每一个Excel文件都是一个Workbook对象，每一个Workbook对象下面都下属N个Worksheet对象，每一个Worksheet对象下面又是通过N个cell（单元格）组成的。

在合并同一个工作簿下面全部的工作表的数据，主要是通过操作当前Workbook对象下面的多个Worksheet对象来完成合并工作。

2、VBA合并代码

2.1合并工作表需要读取工作表内的全部行数，需注意以下两种读取方法的选择

a.读取工作表内全部已定义行数

l = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Column 'l为ts中的工作表有定义列数量+1

b.读取工作表内不间断的全部有数据填充的行数

l = ts.Range("A65536").End(xlUp).Column + 1 'l为ts中的工作表A列有效列数量+1

注意其中End(xlUp)相当于按Ctrl+Shift+↓ 用于获取某一列中被有效数据填充的行

这里我们选择使用法b

2.2、合并同一工作簿下所有的工作表

合并同一个Excel文件下所有的工作表仅需要对工作簿下从第二张工作表开始遍历所有工作表，将其中包含有效信息的行全部复制到第一张工作表中。

以下为具体代码：

Sub mergeonexls() '将同一个工作簿下的所有工作表全部合并到本工作簿下的第一个工作表中

On Error Resume Next

Dim x As Variant, x1 As Variant, w As Workbook, wsh As Worksheet

Dim t As Workbook, ts As Worksheet, i As Integer, l As Integer, h As Long '定义变量/工作簿/工作表/整型

Application.ScreenUpdating = False '屏蔽刷新，提高运行效率

Application.DisplayAlerts = False '屏蔽变化显示，提高运行效率

Set t = ThisWorkbook '代码所在的工作簿t

Set ts = t.Sheets(1) 'ts为工作簿t中的第1个工作表

For i = 2 To t.Sheets.Count '遍历工作簿t中出第一个工作表以外的所有工作表（即从第2到n个工作表sheet）

Set wsh = t.Sheets(i) 'wsh为工作簿t中的第i个工作表

l = ts.Range("A65536").End(xlUp).Column + 1 'l为ts中的工作表有效列数量+1

h = ts.Range("A65536").End(xlUp).Row + 1 'h为ts中的工作表有效行数量+1

'l = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Column 'l为ts中的工作表有定义列数量+1

'h = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Row 'h为ts中的工作表有定义行数量+1

'有效行意味着本行存在有数据填充的单元格，有效列同理

'有定义行意味着本行存在着有相关数据规则的单元格（包括数据序列等情况），有定义列同理

If l = 1 And h = 1 And ts.Cells(1, 1) = "" Then

wsh.UsedRange.Copy ts.Cells(1, 1)

'如果l=1且h=1，ts工作表首单元格为空，则直接将wsh中的数据写入ts中

Else

wsh.UsedRange.Copy ts.Cells(h + 1, 1)

'否则从ts的首个无数据填充行开始写入wsh的数据

End If

Next

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub

2.3、多个Excel文件下每一个工作表一一对应合并需要首先将所需要合并的excel文件全部选中，然后将目标excel文件下工作表index与源excel文件下工作表的index相等的工作表合并（源excel文件下工作表内容写在目标excel文件后）。

具体代码如下：

Sub mergeeveryonexls() '将多个工作簿下的工作表依次对应合并到本工作簿下的工作表，即第一张工作表对应合并到第一张，第二张对应合并到第二张……

On Error Resume Next

Dim x As Variant, x1 As Variant, w As Workbook, wsh As Worksheet

Dim t As Workbook, ts As Worksheet, i As Integer, l As Integer, h As Long

'定义变量/工作簿/工作表/整型

Application.ScreenUpdating = False '屏蔽刷新，提高运行效率

Application.DisplayAlerts = False '屏蔽变化显示，提高运行效率

x = Application.GetOpenFilename(FileFilter:="Excel文件 (*.xls; *.xlsx),*.xls; *.xlsx,所有文件(*.*),*.*", _

Title:="Excel选择", MultiSelect:=True)

'选择需要进行合并的工作簿（即excel文件）集合，可以多选

Set t = ThisWorkbook '代码所在的工作簿t

For Each x1 In x '对每一个工作表集合中的工作簿x1

If x1 <> False Then '如果x1存在

Set w = Workbooks.Open(x1) '打开x1到w

For i = 1 To w.Sheets.Count '遍历w中所有的工作表（即sheet）

If i > t.Sheets.Count Then t.Sheets.Add After:=t.Sheets(t.Sheets.Count)

'如果工作簿w中工作表数量多于代码所在工作簿t中工作表数量,则将w中的工作表直接添加到t中

Set ts = t.Sheets(i) 'ts为工作簿t中的第i个工作表

Set wsh = w.Sheets(i) 'wsh为工作簿t中的第i个工作表

l = ts.Range("A65536").End(xlUp).Column + 1 'l为ts中的工作表有效列数量+1

h = ts.Range("A65536").End(xlUp).Row + 1 'h为ts中的工作表有效行数量+1

'l = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Column 'l为ts中的工作表有定义列数量+1

'h = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Row 'h为ts中的工作表有定义行数量+1

'有效行意味着本行存在有数据填充的单元格，有效列同理

'有定义行意味着本行存在着有相关数据规则的单元格（包括数据序列等情况），有定义列同理

If l = 1 And h = 1 And ts.Cells(1, 1) = "" Then

wsh.UsedRange.Copy ts.Cells(1, 1)

'如果l=1且h=1，ts工作表首单元格为空，则直接将wsh中的数据写入ts中

Else

wsh.UsedRange.Copy ts.Cells(h + 1, 1)

'否则从ts的首个无数据填充行开始写入wsh的数据

End If

Next

w.Close

End If

Next

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub