excel-合并多个Excel文件--VBA合并当前目录下所有Excel工作簿中的所有工作表

在网上找EXCEL多文件合并的方法，思路：

一、Linux 或者window+cmder，直接用命令行cat合并EXCEL文件，但是，需要安装辅助东西才能直接处理（也许也不可以，但是，可以用文件格式转换工具转换是可行的，把EXCEL文件转换成txt文件，再操作，操作好了，再转换成EXCEL格式）；还有一种是perl或者Python有自己自带的EXCEL处理包，能像处理数组一样，实现直接处理EXCEL文件的目的

二、EXCEL自带VBA编程实现合并，但是，网上搜了很多，格式很类似的VBA脚本，都不能很完美的实现合并功能，都或多或少合并有不完整的现象，于是遇到下面的这个版本，可以很好正确的实现合并，就在此把脚本里边每条的功能给详细注释一下，如有不正确的地方，欢迎留言，感激不尽~

脚本：

Sub 合并目录所有工作簿全部工作表()

Dim MP, MN, AW, Wbn, wn               #定义变量（MP=MyPath，MN=MyName，AW=ActiveWorkbookName，Wbn=WorkBookName,wn=workbooksheet(i)name）,但未指定变量类型，这样不是很规范

Dim Wb As Workbook                        #定义变量Wb为工作簿类型   #Dim Wbn As string，G As Long  #定义变量Wbn为字符型,G为长整型 #Dim Num,ini As Long #定义Num未声明类型，定义并声明ini为长整型

Dim i, a, b, d, c, e                               #定义变量,但未指定变量类型，这样不是很规范

Application.ScreenUpdating = False  #关闭屏幕刷新

MP = ActiveWorkbook.Path               #将当前工作簿（活动工作簿）的路径赋值给MP

MN = Dir(MP & "\" & "*.xls")               #将当前工作簿（活动工作簿）的路径加上\*.xls后缀,从而捕获到的*位置的所有文件名的值，Dir 会返回匹配 pathname 的第一个文件名。若想得到其它匹配 pathname 的文件名，再一次调用 Dir，且不要使用参数。如果已没有合乎条件的文件，则 Dir 会返回一个零长度字符串 ("")。一旦返回值为零长度字符串，并要再次调用 Dir 时，就必须指定 pathname，否则会产生错误。

AW = ActiveWorkbook.Name            #将当前工作簿（活动工作簿）的名字赋值给AW（不带后缀，只是名字）

Num = 0     #Num=0

e = 1           #ini=0

Do While MN <> ""                           #运行下面的DO while 循环，直到MN值为空值

　　If MN <> AW Then                    #如果，MN值不等于AW值，就运行IF到END IF之间的判断语句

　　　　Set Wb = Workbooks.Open(MP & "\" & MN)                #打开MP\路径下名为MN变量值的工作簿，并引用（Set的作用）赋给Wb  ##引用赋值如果，对Wb更改了，被引用的也随着更改了，详细见下边PS（3）

　　　　a = a + 1    　　　　　　                                            #对a进行循环累加

　　　　With Workbooks(1).ActiveSheet                                   #对已打开的所有工作簿中的第一个工作簿中的被激活的工作表运用with语句

　　　　　　For i = 1 To Sheets.Count  　　　　　　　           #在Workbooks(1).ActiveSheet的所有sheet中循环

　　　　　　　　If Sheets(i).Range("a1") <> "" Then                #如果Wb工作簿的第i个工作表的A1单元格内容不为空，就进行IF判断内容，如果为空，跳过IF判断进入For的下一个循环

　　　　　　　　　　Wb.Sheets(i).Range("a1").Resize(1, Sheets(i).UsedRange.Columns.Count).Copy  .Cells(1, 1)  #将wb工作簿中第i个工作表的A1单元格区域扩充为一行，有应用痕迹列数（x）大小的区域，即A1：x1区域，  扩充后区域内的内容复制到Workbooks(1).ActiveSheet的A1位置

　　　　　　　　　　d = Wb.Sheets(i).UsedRange.Columns.Count   　　#wb工作簿的第i工作表有应用痕迹的列计数，并赋值给d

　　　　　　　　　　c = Wb.Sheets(i).UsedRange.Rows.Count - 1   　　#wb工作簿的第i工作表有应用痕迹的行计数，并赋值给c

　　　　　　　　　　wn = Wb.Sheets(i).Name　　　　　　　　　　　　#wb工作簿的第i个工作表的名字赋值给wn

　　　　　　　　　　.Cells(1, d + 1) = "表名"　　　　　　　　　　　　  #Workbooks(1).ActiveSheet工作表的第1行，第d+1列单元格填充“表名”字符串　
　　　　　　　　　　.Cells(e + 1, d + 1).Resize(c, 1) = MN & wn　　　　#Workbooks(1).ActiveSheet工作表的第e+1行，第d+1列区域扩充为c行，1列区域，并在该区域填充为MN & wn
　　　　　　　　　　e = e + c　　　　　　　　　　　　　　　　　　　
　　　　　　　　　　Wb.Sheets(i).Range("a2").Resize(c, d).Copy   .Cells(.Range("a1048576").End(xlUp).Row + 1, 1)   #将区域内容，复制到Workbooks(1).ActiveSheet中，每次从Workbooks(1).ActiveSheet的最后一个非空行开始粘贴

　　　　　　　　End If

　　　　　　Next
　　　　　　Wbn = Wbn & Chr(13) & Wb.Name                                         #将Wbn的值加上空格和Wb工作簿的名称后赋值给Wbn

　　　　　　Wb.Close False　　　　　　　　　　　　　　　　　　　　#将Wb工作簿关闭
　　　　End With
　　End If
MN = Dir　　　　　　　　　　　　　　　　　　　　　　　　　　　　　#获得上边Dir匹配到的下一次文件名；#Dir 会返回匹配 pathname 的第一个文件名。若想得到其它匹配 pathname 的文件名，再一次调用 Dir，且不要使用参数。如果已没有合乎条件的文件，则 Dir 会返回一个零长度字符串 ("")。一旦返回值为零长度字符串，并要再次调用 Dir 时，就必须指定 pathname，否则会产生错误。
Loop
Range("a1").Select　　　　　　　　　　　　　　　　　　　　　　　　 #选中当前工作簿的第一个单元格
Application.ScreenUpdating = True　　　　　　　　　　　　　　　　　 #开启屏幕刷新
MsgBox "共合并了" & a & "个工作薄下全部工作表。如下：" & Chr(13) & Wbn, vbInformation, "提示"        #给出最后提示

End Sub

参考：https://www.jianshu.com/p/f52e6edc2d63

参考：https://zhinan.sogou.com/guide/detail/?id=1610003487  #将模块加入按钮（窗体控件）

注意：被合并的文件第一行都得是行标题，而且只保留被合并的第一个文件的第一行，没有行标题会出错，缺少数据；被合并的每个文件的A1单元格不能是空单元格，否则整个文件将不会别合并；

实例：

1文件是：

2文件是：

1、2是要合并的文件，3是新建的空文件；要放到一个目录文件夹下；

打开3文件，打开VBA，粘贴脚本保存，3文件保存为启用宏的格式文件；

运行宏；

结果展示：

说明：使用的话直接复制粘贴PPS下的脚本即可，把#更换为了符合VBA的注释格式‘

PS：

（1）Resize

使用Range对象的Resize属性调整指定区域的大小，并返回调整大小后的单元格区域，如下面的代码所示。
Sub Resize()
Sheet4.Range("A1").Resize(3, 3).Select   ‘意思就是把工作表4中的A1单元格扩充为3行3列大小的区域，结果为A1：C3区域
End Sub
代码解析：
Resize过程使用Range对象的Resize属性选中A1单元格扩展为三行三列后的区域。
Resize属性的语法如下：
expression.Resize(RowSize, ColumnSize)
参数expression是必需的，返回要调整大小的Range 对象
参数RowSize是可选的，新区域中的行数。如果省略该参数，则该区域中的行数保持不变。
参数ColumnSize是可选的，新区域中的列数。如果省略该参数。则该区域中的列数保持不变。

参考：http://www.excelpx.com/thread-174857-1-1.html

（2）Dir

这是一个用VBA函数Dir()构造的判断文件是否存在的自定义函数

Function FileExists(fname) As Boolean ' Returns TRUE if the file exists Dim x As String x = Dir(fname) If x <> "" Then FileExists = True _ Else FileExists = False End Function

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// Dir 函数

返回一个 String，用以表示一个文件名、目录名或文件夹名称，它必须与指定的模式或文件属性、或磁盘卷标相匹配。

语法

Dir[(pathname[, attributes])]

Dir 函数的语法具有以下几个部分：

部分描述pathname可选参数。用来指定文件名的字符串表达式，可能包含目录或文件夹、以及驱动器。如果没有找到 pathname，则会返回零长度字符串 ("")。attributes可选参数。常数或数值表达式，其总和用来指定文件属性。如果省略，则会返回匹配 pathname 但不包含属性的文件。

设置值

attributes 参数的设置可为：

常数值描述vbNormal0(缺省) 指定没有属性的文件。vbReadOnly1指定无属性的只读文件vbHidden2指定无属性的隐藏文件VbSystem4指定无属性的系统文件 在Macintosh中不可用。vbVolume8指定卷标文件；如果指定了其它属性，则忽略vbVolume 在Macintosh中不可用。vbDirectory16指定无属性文件及其路径和文件夹。vbAlias64指定的文件名是别名，只在Macintosh上可用。

注意 这些常数是由 VBA 所指定的，在程序代码中的任何位置，可以使用这些常数来替换真正的数值。

说明

在 Microsoft Windows 中， Dir 支持多字符 (*) 和单字符 (?) 的通配符来指定多重文件。

在 Macintosh 中，这些字符作为合法文件名字符并且不能作为通配符来指定多个文件

由于 Macintosh 不支持通配符，使用文件类型指定文件组。可以使用 MacID 函数指定文件类型而不用文件名。比如，下列语句返回当前文件夹中第一个TEXT文件的名称:

Dir("SomePath", MacID("TEXT"))

为选中文件夹中所有文件，指定一空串:

Dir("")

在 Microsoft Windows 中，如果在Dir函数中使用MacID函数，将产生错误。

任何大于256的attribute值都被认为是MacID 函数的值。

在第一次调用 Dir 函数时，必须指定 pathname，否则会产生错误。如果也指定了文件属性，那么就必须包括 pathname。

Dir 会返回匹配 pathname 的第一个文件名。若想得到其它匹配 pathname 的文件名，再一次调用 Dir，且不要使用参数。如果已没有合乎条件的文件，则 Dir 会返回一个零长度字符串 ("")。一旦返回值为零长度字符串，并要再次调用 Dir 时，就必须指定 pathname，否则会产生错误。不必访问到所有匹配当前 pathname 的文件名，就可以改变到一个新的 pathname 上。但是，不能以递归方式来调用 Dir 函数。以 vbDirectory 属性来调用 Dir 不能连续地返回子目录。

提示 由于文件名并不会以特别的次序来返回，所以可以将文件名存储在一个数组中，然后再对这个数组排序。

参考：http://club.excelhome.net/thread-121668-1-1.html

（3）Set

VBA中SET是定义一个有属性和方法的对象

Excel版本参考：2010
1、语法

Set objectvar = {[New]
objectexpression | Nothing}

Set 语句的语法包含下面部分：

描述

objectvar
必需的。变量或属性的名称，遵循标准变量命名约定。    

New
可选的。通常在声明时使用 New，以便可以隐式创建对象。如果 New 与
Set 一起使用，则将创建该类的一个新实例。如果
objectvar 包含了一个对象引用，则在赋新值时释放该引用。不能使用 New 关键字来创建任何内部数据类型的新实例，也不能创建从属对象。    

objectexpression
必需的。由对象名，所声明的相同对象类型的其它变量，或者返回相同对象类型的函数或方法所组成的表达式。    

Nothing
可选的。断绝 objectvar 与任何指定对象的关联。若没有其它变量指向
objectvar 原来所引用的对象，将其赋为 Nothing 会释放该对象所关联的所有系统及内存资源。
2、说明：

为确保合法，objectvar 必须是与所赋对象相一致的对象类型。

Dim、Private、Public、ReDim以及 Static 语句都只声明了引用对象的变量。在用
Set 语句将变量赋为特定对象之前，该变量并没有引用任何实际的对象。

下面的示例说明了如何使用 Dim 来声明 Form1 类型的数组。Form1 实际上还没有实例。然后使用
Set 将新创建的 Form1 的实例的引用赋给 myChildForms 变量。在 MDI
应用程序中可以使用这些代码来创建子窗体。
Dim myChildForms(1 to 4) As Form1
Set myChildForms(1) = New Form1
Set myChildForms(2) = New Form1
Set myChildForms(3) = New Form1
Set myChildForms(4) = New Form1

通常，当使用 Set 将一个对象引用赋给变量时，并不是为该变量创建该对象的一份副本，而是创建该对象的一个引用。可以有多个对象变量引用同一个对象。因为这些变量只是该对象的引用，而不是对象的副本，因此对该对象的任何改动都会反应到所有引用该对象的变量。不过，如果在
Set 语句中使用 New 关键字，那么实际上就会新建一个该对象的实例。
3、Set 语句示例

该示例使用 Set 语句将对象引用赋给变量。假定 YourObject 指向一个具有 Text
属性的合法对象。
Dim YourObject, MyObject, MyStr
Set MyObject = YourObject    '对象引用赋值。
'MyObject 和 YourObject 引用同一个对象。
YourObject.Text = "Hello World"    '初始化属性。
MyStr = MyObject.Text    '返回 "Hello World"。
'脱离关联。MyObject 不再引用 YourObject。
Set MyObject = Nothing    '释放该对象。

 参考：https://wenwen.sogou.com/z/q705635956.htm

 

 

PPS:(直接复制粘贴脚本即可，修改了符合VBA的注释符号)

Sub 合并目录所有工作簿全部工作表()

Dim MP, MN, AW, Wbn, wn '定义变量（MP=MyPath，MN=MyName，AW=ActiveWorkbookName，Wbn=WorkBookName,wn=workbooksheet(i)name）,但未指定变量类型，这样不是很规范

Dim Wb As Workbook '定义变量Wb为工作簿类型 #Dim Wbn As string，G As Long #定义变量Wbn为字符型,G为长整型 #Dim Num,ini As Long #定义Num未声明类型，定义并声明ini为长整型

Dim i, a, b, d, c, e '定义变量,但未指定变量类型，这样不是很规范

Application.ScreenUpdating = False '关闭屏幕刷新

MP = ActiveWorkbook.Path '将当前工作簿（活动工作簿）的路径赋值给MP

MN = Dir(MP & "\" & "*.xls") '将当前工作簿（活动工作簿）的路径加上\*.xls后缀,从而捕获到的*位置的所有文件名的值，Dir 会返回匹配 pathname 的第一个文件名。若想得到其它匹配 pathname 的文件名，再一次调用 Dir，且不要使用参数。如果已没有合乎条件的文件，则 Dir 会返回一个零长度字符串 ("")。一旦返回值为零长度字符串，并要再次调用 Dir 时，就必须指定 pathname，否则会产生错误。

AW = ActiveWorkbook.Name '将当前工作簿（活动工作簿）的名字赋值给AW（不带后缀，只是名字）

Num = 0 'Num=0

e = 1 'ini=0

Do While MN <> "" '运行下面的DO while 循环，直到MN值为空值

If MN <> AW Then '如果，MN值不等于AW值，就运行IF到END IF之间的判断语句

Set Wb = Workbooks.Open(MP & "\" & MN) '打开MP\路径下名为MN变量值的工作簿，并引用（Set的作用）赋给Wb ##引用赋值如果，对Wb更改了，被引用的也随着更改了，详细见下边PS（3）

a = a + 1 '对a进行循环累加

With Workbooks(1).ActiveSheet '对已打开的所有工作簿中的第一个工作簿中的被激活的工作表运用with语句

For i = 1 To Sheets.Count '在Workbooks(1).ActiveSheet的所有sheet中循环

If Sheets(i).Range("a1") <> "" Then '如果Workbooks(1).ActiveSheet工作簿的第i个工作表的A1单元格内容不为空，就进行IF判断内容

Wb.Sheets(i).Range("a1").Resize(1, Sheets(i).UsedRange.Columns.Count).Copy .Cells(1, 1) '将wb工作簿中第i个工作表的A1单元格区域扩充为一行，有应用痕迹列数（x）大小的区域，即A1：x1区域， 扩充后区域内的内容复制到Workbooks(1).ActiveSheet的A1位置

d = Wb.Sheets(i).UsedRange.Columns.Count 'wb工作簿的第i工作表有应用痕迹的列计数，并赋值给d

c = Wb.Sheets(i).UsedRange.Rows.Count - 1 'wb工作簿的第i工作表有应用痕迹的行计数，并赋值给c

wn = Wb.Sheets(i).Name 'wb工作簿的第i个工作表的名字赋值给wn

.Cells(1, d + 1) = "表名" 'Workbooks(1).ActiveSheet工作表的第1行，第d+1列单元格填充“表名”字符串
.Cells(e + 1, d + 1).Resize(c, 1) = MN & wn 'Workbooks(1).ActiveSheet工作表的第e+1行，第d+1列区域扩充为c行，1列区域，并在该区域填充为MN & wn
e = e + c
Wb.Sheets(i).Range("a2").Resize(c, d).Copy .Cells(.Range("a1048576").End(xlUp).Row + 1, 1) '将区域内容，复制到Workbooks(1).ActiveSheet中，每次从Workbooks(1).ActiveSheet的最后一个非空行开始粘贴

End If

Next
Wbn = Wbn & Chr(13) & Wb.Name '将Wbn的值加上空格和Wb工作簿的名称后赋值给Wbn

Wb.Close False '将Wb工作簿关闭
End With
End If
MN = Dir '获得上边Dir匹配到的下一次文件名；#Dir 会返回匹配 pathname 的第一个文件名。若想得到其它匹配 pathname 的文件名，再一次调用 Dir，且不要使用参数。如果已没有合乎条件的文件，则 Dir 会返回一个零长度字符串 ("")。一旦返回值为零长度字符串，并要再次调用 Dir 时，就必须指定 pathname，否则会产生错误。
Loop
Range("a1").Select '选中当前工作簿的第一个单元格
Application.ScreenUpdating = True '开启屏幕刷新
MsgBox "共合并了" & a & "个工作薄下全部工作表。如下：" & Chr(13) & Wbn, vbInformation, "提示" '给出最后提示
End Sub