玖叶教程网

利用vba的强大功能实现excel文件的拆分、合并。使用中只要通过该excel宏文件，只要打开需要合并、拆分的excel文件，就可自行完成合并、拆分工作。不需要为每个excel文件写语句，工作中简便、实用。

本文介绍使用vba功能来完成多文件合并工作，要求需合并的文件在同一目录下，并具有相同的文件结构。这种合并办法适用于一次合并或无需随时更新合并文件时使用。如果需要合并的文件经常修改，修改的结果要在合并文件中及时更新，可以使用excel query实现。

一．如果我们需要将“资料”文件夹下的excel文件进行合并，xls、xlsx格式都可以同时合并。合并后生成的合并文件“合并文件.xlsx”就存放在“资料”文件夹的上级文件夹中。

首先，我们需要打开“vb功能.xlsm”功能文件， 点击 “将多个Excel文件合并”命令，如图：

在打开 文件夹对话框，选择需要合并文件所在的文件夹，这里选择“资料”文件夹，然后确定。

出现提示后，点击确定“是”后开始合并文件，根据文件大小、多少所需时间不同。

合并完成后，显示合并情况：

最后，合并文件保存即可。

二．相关vb语句如下，使用了一个函数，一个过程

Public Function getfoldername() As String

'选择文件夹函数

Dim strFolder As String

With Application.FileDialog((msoFileDialogFolderPicker))

'文件对话框的题目，根据个人情况进行设定

.Title = "Select Folder"

'默认打开的文件对话框路径，此处是d盘

.InitialFileName = "d:\"

If .Show Then '获取到路径

strFolder = .SelectedItems(1)

getfoldername = strFolder

End If

End With

End Function

Sub hbgzpx()

'合并指定目录下全部工作表，文件夹下不能有“合并文件”文件， 如果有“合并文件” 的名称，则不纳入汇总

'新建“合并文件”文件，合并文件用

Dim mp, np, MN, AW, Wbn, wn

Dim Wb As Workbook

Dim i, a, b, d, c, e, Ans

Application.ScreenUpdating = False

'MP = ActiveWorkbook.Path '获取当前工作薄的路径

'获取需要合并的工作薄的路径

mp = getfoldername

If mp = "" Then

Exit Sub

End If

Ans = MsgBox("开始文件合并，是否继续?", vbYesNo)

If Ans <> vbYes Then Exit Sub

'遍历Excel文件,还应有xlsx文件

MN = Dir(mp & "\" & "*.xls*")

'AW = ActiveWorkbook.Name '获取当前工作簿名称

AW = "合并文件"

Num = 0

e = 1

'新建“合并文件”文件，合并文件用。合并文件保存在需合并文件夹的上级目录夹中，并保存为xlsx格式

'Workbooks.Add (MP & "合并文件.xlsx") 'Workbooks.Add 扩展

Workbooks.Add

'读取需合并文件的上级目录

np = Left(mp, InStrRev(mp, "\"))

'将文件重新命名“合并文件”

'将工作簿另存为EXCEL默认格式xls

'ActiveWorkbook.SaveAs Filename:=np & "\合并文件", FileFormat:=xlNormal

'将工作簿另存为xlsx

ActiveWorkbook.SaveAs Filename:=np & "合并文件", FileFormat:=51

Do While MN <> ""

If MN <> AW Then

Set Wb = Workbooks.Open(mp & "\" & MN)

a = a + 1

'Workbooks(2)激活文件编号,Workbooks("合并文件")

With Workbooks("合并文件.xlsx").ActiveSheet

For i = 1 To Sheets.Count

'复制工作表内容

If Sheets(i).Range("a1") <> "" Then

Wb.Sheets(i).Range("a1").Resize(1, Sheets(i).UsedRange.Columns.Count).Copy .Cells(1, 1)

d = Wb.Sheets(i).UsedRange.Columns.Count

c = Wb.Sheets(i).UsedRange.Rows.Count - 1

'增加一列

wn = Wb.Sheets(i).Name

.Cells(1, d + 1) = "表名"

.Cells(e + 1, d + 1).Resize(c, 1) = MN & wn

e = e + c

Wb.Sheets(i).Range("a2").Resize(c, d).Copy .Cells(.Range("a1048576").End(xlUp).Row + 1, 1)

End If

Next

Wbn = Wbn & Chr(13) & Wb.Name

Wb.Close False

End With

End If

MN = Dir

Loop

Range("a1").Select

Application.ScreenUpdating = True

MsgBox "共合并了" & a & "个工作薄下全部工作表。如下：" & Chr(13) & Wbn, vbInformation, "提示"

End Sub

三．利用开发工具涉及的相关按钮，将按钮和对应的vb程序关联就可以了。

Private Sub CommandButton2_Click()

hbgzpx

'合并当前目录下所有工作簿的全部工作

End Sub