合并excel表格。

最近朋友提出來了一個(gè)問題怎么快速合并一個(gè)文件夾內(nèi)的excel表格數(shù)據(jù)，本著程序員 發(fā)現(xiàn)問題解決問題的原則，去查詢了一下相關(guān)資料， 原來Windows office中的excel有代碼編輯的功能，使用的是VB語言，之前有過接觸可是都忘記了。然后找到如下代碼塊， 先看效果。

QQ截圖20181030160154.png

QQ截圖20181030153814.png

合并前表1

QQ截圖20181030153831.png

合并前表2

QQ截圖20181030154629.png

代碼如下：

Sub 合并當(dāng)前目錄下所有工作簿的全部工作表()
Dim MyPath, MyName, AWbName  '定義變量，但未指定變量類型，這樣一般是不規(guī)范的
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  '關(guān)閉屏幕刷新
MyPath = ActiveWorkbook.Path '將當(dāng)前工作簿的路徑賦值給mypath
MyName = Dir(MyPath & "\" & "*.xls")  '將活動(dòng)工作簿的名字加上.xls后賦值給myname
AWbName = ActiveWorkbook.Name '將激活工作簿的文件名賦值給awbname
Num = 0
ini = 0
Do While MyName <> ""  '運(yùn)行下面的do while循環(huán)，直到myname的值為空。
If MyName <> AWbName Then  '如果myname與awbname的值不同，則運(yùn)行下一個(gè)end if前的語句
Set Wb = Workbooks.Open(MyPath & "\" & MyName) '打開mypath路徑下名字為myname變量值的工作簿，并將其賦給wb
Num = Num + 1 '對(duì)num累加
With Workbooks(1).ActiveSheet  '對(duì)已打開的所有工作簿中的第一個(gè)工作簿中的被激活的工作表運(yùn)用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工作簿中第一個(gè)工作表的第一行有應(yīng)用痕跡的單元格內(nèi)容復(fù)制到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工作簿中第一個(gè)工作表的第二行有應(yīng)用痕跡的單元格內(nèi)容復(fù)制到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工作簿中第一個(gè)工作表的第三行有應(yīng)用痕跡的單元格內(nèi)容復(fù)制到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工作簿中第一個(gè)工作表的第四行有應(yīng)用痕跡的單元格內(nèi)容復(fù)制到Workbooks(1).ActiveSheet的相同位置
ini = 1
End If
For G = 1 To Sheets.Count '在Workbooks(1).ActiveSheet的所有sheet中循環(huán)。
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) 第一個(gè)參數(shù)表示從第幾行開始復(fù)制 將WB中的A2到最后一行最后一列的非空單元格的內(nèi)容復(fù)制到Workbooks(1).ActiveSheet中，每次從Workbooks(1).ActiveSheet的最后一個(gè)非空行開始粘貼
Next
WbN = WbN & Chr(13) & Wb.Name '將wbn的值加上空格和wb的名稱后賦值給wbn
Wb.Close False  '將wb關(guān)閉
End With
End If
MyName = Dir
Loop
Range("A1").Select '選中當(dāng)前工作簿的第一個(gè)單元格
Application.ScreenUpdating = True  '開啟屏幕刷新
MsgBox "共合并了" & Num & "個(gè)工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示" '給出最后提示
End Sub

結(jié)束

注意：wps2016版本不支持代碼查看功能，Windows office 的excel自帶代碼查看功能，本文章使用的是WPS 2019(推薦使用)

QQ截圖20181030155922.png