合并excel表格。
最近朋友提出来了一个问题怎么快速合并一个文件夹内的excel表格数据，本着程序员 发现问题解决问题的原则，去查询了一下相关资料， 原来Windows office中的excel有代码编辑的功能，使用的是VB语言，之前有过接触可是都忘记了。然后找到如下代码块， 先看效果。
QQ截图20181030160154.png
QQ截图20181030153814.png
合并前表1
QQ截图20181030153831.png
合并前表2
QQ截图20181030154629.png
合并后数据表
代码如下：
Sub 合并当前目录下所有工作簿的全部工作表()
Dim MyPath, MyName, AWbName '定义变量，但未指定变量类型，这样一般是不规范的
Dim Wb As Workbook, WbN As String '定义变量wb为工作簿类型，wbn为字符型
Dim G As Long '定义G为长整型
Dim Num, ini As Long '定义num，并定义和声明ini为长整型（注意，num类型未定）
Application.ScreenUpdating = False '关闭屏幕刷新
MyPath = ActiveWorkbook.Path '将当前工作簿的路径赋值给mypath
MyName = Dir(MyPath & "\" & "*.xls") '将活动工作簿的名字加上.xls后赋值给myname
AWbName = ActiveWorkbook.Name '将激活工作簿的文件名赋值给awbname
Num = 0
ini = 0
Do While MyName <> "" '运行下面的do while循环，直到myname的值为空。
If MyName <> AWbName Then '如果myname与awbname的值不同，则运行下一个end if前的语句
Set Wb = Workbooks.Open(MyPath & "\" & MyName) '打开mypath路径下名字为myname变量值的工作簿，并将其赋给wb
Num = Num + 1 '对num累加
With Workbooks(1).ActiveSheet '对已打开的所有工作簿中的第一个工作簿中的被激活的工作表运用with语句
If ini = 0 Then
Wb.Sheets(1).Range(Wb.Sheets(1).Cells(1, 1), Wb.Sheets(1).Cells(1, Wb.Sheets(1).UsedRange.Columns.Count)).Copy .Cells(1, 1) '将wb工作簿中第一个工作表的第一行有应用痕迹的单元格内容复制到Workbooks(1).ActiveSheet的相同位置
Wb.Sheets(1).Range(Wb.Sheets(1).Cells(2, 1), Wb.Sheets(1).Cells(2, Wb.Sheets(1).UsedRange.Columns.Count)).Copy .Cells(2, 1) '将wb工作簿中第一个工作表的第二行有应用痕迹的单元格内容复制到Workbooks(1).ActiveSheet的相同位置
Wb.Sheets(1).Range(Wb.Sheets(1).Cells(3, 1), Wb.Sheets(1).Cells(3, Wb.Sheets(1).UsedRange.Columns.Count)).Copy .Cells(3, 1) '将wb工作簿中第一个工作表的第三行有应用痕迹的单元格内容复制到Workbooks(1).ActiveSheet的相同位置
Wb.Sheets(1).Range(Wb.Sheets(1).Cells(4, 1), Wb.Sheets(1).Cells(4, Wb.Sheets(1).UsedRange.Columns.Count)).Copy .Cells(4, 1) '将wb工作簿中第一个工作表的第四行有应用痕迹的单元格内容复制到Workbooks(1).ActiveSheet的相同位置
ini = 1
End If
For G = 1 To Sheets.Count '在Workbooks(1).ActiveSheet的所有sheet中循环。
Wb.Sheets(G).Range(Wb.Sheets(G).Cells(5, 1), Wb.Sheets(G).Cells(Wb.Sheets(G).UsedRange.Rows.Count, Wb.Sheets(G).UsedRange.Columns.Count)).Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1) 'Wb.Sheets(G).Range(Wb.Sheets(G).Cells(5, 1) 第一个参数表示从第几行开始复制 将WB中的A2到最后一行最后一列的非空单元格的内容复制到Workbooks(1).ActiveSheet中，每次从Workbooks(1).ActiveSheet的最后一个非空行开始粘贴
Next
WbN = WbN & Chr(13) & Wb.Name '将wbn的值加上空格和wb的名称后赋值给wbn
Wb.Close False '将wb关闭
End With
End If
MyName = Dir
Loop
Range("A1").Select '选中当前工作簿的第一个单元格
Application.ScreenUpdating = True '开启屏幕刷新
MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示" '给出最后提示
End Sub
结束
注意：wps2016版本不支持代码查看功能，Windows office 的excel自带代码查看功能，本文章使用的是WPS 2019(推荐使用)
QQ截图20181030155922.png
网友评论