网站首页 > 知识剖析 正文
利用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
猜你喜欢
- 2025-07-09 代码分享:Python和VB代码实现批量合并EXCEL数据,拿走不谢
- 2025-07-09 vba常用代码总结(excel vba常用代码175个实例解析)
- 2025-07-09 上传图片或附件到指定文件夹或共享文件夹的通用函数
- 2025-07-09 注意了!在VBA使用Dir函数的“隐秘陷阱”
- 2025-07-09 ExcelVBA函数:保存当前工作簿的临时副本
- 2025-07-09 Excel常用技能分享与探讨(5-宏与VBA简介 VBA-实用自定义过程)
- 2025-07-09 Excel常用技能分享与探讨(5-宏与VBA简介 VBA常用到的函数一)
- 2025-07-09 Word隐藏的自动备份功能!每次保存生成独立副本,防丢稿终极方案
- 2025-07-09 保存后自动备份工作簿 《Excel VBA 从入门到放弃系列》
- 2025-07-09 Excel VBA学习笔记:取文件夹中所有文件:DIR函数
- 最近发表
-
- 表格存储 SQL 查询多元索引(表格存储 sql 查询多元索引的方法)
- 数据库教程-SQL Server多条件模糊查询
- Twitch宣布放弃Flash并逐步转型至HTML5平台
- 移动平台最强播放器MX Player:终于支持安卓5.0了!
- win10 NFS+黑群晖远程加载管理Windows文件夹(读写NTFS格式+高清播放器)
- Android端VLC 3.3版本发布,重新设计播放器界面
- 不仅仅被苹果封杀!Youtube宣布迁移Flash
- 揭开网站背后的魔法:B/S系统原来这么简单!
- Adobe Animate (An) 2020网页设计软件下载和安装教程
- Adobe发布“巨量”安全更新:遏制Flash“祸害”Linux
- 标签列表
-
- xml (46)
- css animation (57)
- array_slice (60)
- htmlspecialchars (54)
- position: absolute (54)
- datediff函数 (47)
- array_pop (49)
- jsmap (52)
- toggleclass (43)
- console.time (63)
- .sql (41)
- ahref (40)
- js json.parse (59)
- html复选框 (60)
- css 透明 (44)
- css 颜色 (47)
- php replace (41)
- css nth-child (48)
- min-height (40)
- xml schema (44)
- css 最后一个元素 (46)
- location.origin (44)
- table border (49)
- html tr (40)
- video controls (49)