合并文件夹内所有Excel文件（目前仅限于合并单层文件夹，如果文件夹下面有文件夹，暂未加入此功能，默认合并所有文件的所有Sheet）优化文件名

几经修改，终于算是成为自己较为满意的一个VBA程序（2020-6-6修正）

然，因个人才疏学浅，如有疏漏，希望各位前辈多多指正~在下先行谢过~

1、考虑到Excel新建Sheet的命名规则

2、考虑到xls 和 xlsx文件（office2007前后的版本）

3、考虑到子程序会不会对使用者造成误导，所以全部更改为Function

F、考虑到新建Excel的命名优化

5、考虑到隐藏工作表可能会带来的影响，已经提前进行了预处理

6、考虑到同事（使用者）的表格可能存在不规范的情况，合并工作表的时候充分考虑了UsedRange所可能带来的影响

7、考虑到同事（使用者）可能会有别的文件夹合并需求，所以做了用户自己选的文件夹的对话框

8、考虑到有的表格会有是否更新链接的提示，已经在Workbooks.Open()添加了可选参数，忽略提示，并且默认为不更新链接

9、处理之后不会保存对源文件的修改，保留了源文件的完整性~

'合并文件夹内所有Excel文件（目前仅限于合并单层文件夹，如果文件夹下面有文件夹，暂未加入此功能，默认合并所有文件的所有Sheet）
'升级版_优化合并的文件名_命名方式变更为：文件夹名字 + 合并的文件，更方便区分是那个文件夹下面的合并文件（xls + xlsx文件皆可用）

'合并文件夹内所有Excel文件（目前仅限于合并单层文件夹，如果文件夹下面有文件夹，暂未加入此功能，默认合并所有文件的所有Sheet）
'升级版1.0_优化合并的文件名_命名方式变更为：文件夹名字 + 合并的文件，更方便区分是那个文件夹下面的合并文件，并且将子程序改为Function，不会误导同事操作其他程序
'升级版2.0_优化含有链接文件，默认不更新链接，防止弹窗影响程序运行Sub 合并文件夹内所有文件()Dim myPath$, myFile$, myPath1$, myPath2$, WB As Workbook, new_book As Workbook, yes_no '这个$ 是相当于定义字符串yes_no = MsgBox("兄台，此程序将会合并您稍后选择的文件夹内所有Excel文件" & Chr(13) & "执行过程中，请勿随意操作电脑" & Chr(13) & Chr(13) & "       请确认，是否继续执行", vbYesNo)If yes_no = 7 Then Exit Sub '如果点击否，则取消程序的执行'调用函数，获取用户选择的文件夹，并且在最后加上一个反斜杠，用于下面的文件列表获取myPath2 = ChooseFolder  '这里的路径是没有加入最后的"\"的myPath = myPath2 & "\"myPath1 = InStrRev(myPath2, "\") '从右向左查找"\"，返回其所在的位置，返回值是一个数字，但是最后会变成一个字符串，所以定义的时候也定义了一个字符串If myPath1 = 0 ThenmyPath1 = ""    '如果找不到"\"，那么就说明用户选择是主硬盘，如：C:\\等，这样就 返回空值ElsemyPath1 = Right(myPath2, Len(myPath2) - myPath1) & "_" '如果不是空值，那么就直接可以使用Right提取，使用最开始没有"\"的myPath2这个变量，End IfmyFile = Dir(myPath & "*.xls*") '依次找寻指定路径中的*.xls，或者xlsx文件Set new_book = Workbooks.Add    '创建新增工作簿对象new_book.SaveAs myPath & myPath1 & "Liang_合并后的文件.xlsx"    '创建文件Do While myFile <> "" '当指定路径中有文件时进行循环If myFile <> ThisWorkbook.name And myFile <> myPath1 & "Liang_合并后的文件.xlsx" Then   '如果我们这个宏文件在需要处理的文件夹之中，这个判断就会跳过下面的操作Set WB = Workbooks.Open(Filename:=myPath & myFile, UpdateLinks:=0) '打开符合要求的文件，并且如果遇到需要更新链接的时候，默认不更新Call 合并所有工作表WB.Sheets(1).Copy before:=new_book.Sheets(1)WB.Close 0  '不保存关闭文件Debug.Print (myFile)End IfmyFile = Dir '找寻下一个*.xls，或者xlsx文件Loopnew_book.Savenew_book.CloseSet WB = Nothing    '释放变量内存Set new_book = Nothing    '释放变量内存MsgBox ("兄台，已完成")
End Sub
Public Function ChooseFolder() As String    '定义函数，用于下面的调用'定义并新建一个对话框对象Dim dlgOpen As FileDialogSet dlgOpen = Application.FileDialog(msoFileDialogFolderPicker)'如果当前没有对话框显示，就让他弹出对话框If dlgOpen.Show = -1 Then ChooseFolder = dlgOpen.SelectedItems(1)Set dlgOpen = Nothing
End Function
Function name_clear(name As String) As String   '定义函数，用于下面的调用，并且返回值Dim arr, aarr = Array(":", "：", "\", "/", "", "*", "[", "]")    '这些是创建Sheet时，Excel不允许使用的字符For Each a In arrname = Replace(name, a, "")NextIf Len(name) > 31 Then name = "截断" & Left(name, 29)   '同时，创建Sheet的时候，不可以超过31个字符，所以在这里也进行了替换name_clear = name   '函数返回值
End Function
Function 合并所有工作表()Dim row_num As Long, column_num As Long, row_num_temp As Long, column_num_temp As Long, row_num_merge As Long, column_num_merge As Long, i As Long, arr() As Long, new_name As String, sht As Worksheetnew_name = ActiveWorkbook.nameDebug.Print (name_clear(new_name))'遍历工作表，取消隐藏工作表，并且删除掉...For Each sht In Worksheets'如果不是显示状态（返回值是0，也可以写为：(xlSheetVisible)），则删除If sht.Visible <> xlSheetVisible Thensht.Visible = xlSheetVisibleApplication.DisplayAlerts = False    '删除时不用确认sht.DeleteEnd IfNext'恢复确认，其实很多人不写这一句，作为小程序写不写倒也无所谓的啦，不影响你后面的程序执行，不过如果你的代码很多，流程很长，建议还是写上去，防止预期之外的的错误发生Application.DisplayAlerts = TrueWorksheets.Add.name = name_clear(new_name)ActiveSheet.Move before:=Sheets(1)For i = 2 To Worksheets.Count'忽略隐藏工作表，如果工作表是显示状态，那么返回值是-1(xlSheetHidden)，工作表状态是正常隐藏的话，返回值是0，如果是非常隐藏的话，则是2(xlSheetVeryHidden)Worksheets(i).Activate'UsedRange.row，代表使用的第一个行数，在有空行的时候体现，同理，UsedRange.column，代表使用的第一个列数，在有空列的时候体现'那么使用第一行 + 已使用的行数，这样可以规避顶部/左侧有空行，导致获取已使用行号的数据不符合预期（老赵，如果你看到这里不懂，就自己拆开代码，加上空行空列体会一下）row_num = Worksheets(i).UsedRange.Row + Worksheets(i).UsedRange.Rows.Count - 1column_num = Worksheets(i).UsedRange.Column + Worksheets(i).UsedRange.Columns.Count - 1'如果格式很不规范，那么获取的UsedRange.rows.count就可能是整个表格的行数，所以要规避这种情况，如果相同，就让他减1If row_num = Worksheets(i).Rows.Count Then row_num = row_num - 1If column_num = Worksheets(i).Columns.Count Then column_num = column_num - 1'相当于遍历所有的列，都按ctrl + ↑，取数组的最大值ReDim arr(1 To column_num)For j = LBound(arr) To UBound(arr)row_num_temp = Worksheets(i).Cells(row_num + 1, j).End(xlUp).Rowarr(j) = row_num_tempNextDebug.Print (Application.WorksheetFunction.Max(arr))row_num_temp = Application.WorksheetFunction.Max(arr) '赋予最大值，确定最大的有数据的行数'相当于遍历所有的行，都按ctrl + ←，取数组的最大值'Erase arr 清空数组，但是也可以不用，直接用ReDim也可以，如果要保留数组内容，需要加一个preserveReDim arr(1 To row_num_temp)For j = LBound(arr) To UBound(arr)column_num_temp = Worksheets(i).Cells(j, column_num + 1).End(xlToLeft).Columnarr(j) = column_num_tempNextDebug.Print (Application.WorksheetFunction.Max(arr))column_num_temp = Application.WorksheetFunction.Max(arr) '赋予最大值，确定最大的有数据的列数Worksheets(i).Range(Cells(1, 1), Cells(row_num_temp, column_num_temp)).SelectSelection.Copy Sheets(1).Cells(row_num_merge + 1, 2)Worksheets(1).Cells(row_num_merge + 1, 1) = Worksheets(i).namerow_num_merge = Sheets(1).UsedRange.Rows.CountNext'将首行标题转为所有行（选择空值，=上面的数据）Worksheets(1).ActivateColumns("A:A").SelectSelection.SpecialCells(xlCellTypeBlanks).SelectApplication.CutCopyMode = FalseSelection.FormulaR1C1 = "=R[-1]C"Columns("A:A").SelectSelection.CopySelection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=FalseApplication.CutCopyMode = FalseRange("A1").Select
End Function

合并文件夹内所有Excel文件（目前仅限于合并单层文件夹，如果文件夹下面有文件夹，暂未加入此功能，默认合并所有文件的所有Sheet）优化文件名_变更为：文件夹名字 + 合并的文件-(xls+xlsx)相关推荐

VBA小程序--打开文件夹内所有Excel表格（代码简单，针对xls + xlsx，注释清楚，小白亦可轻松看懂）
PS:使用下面的代码时,请先根据自己所需要处理的文件夹,进行更改mypath的路径 Sub VBA打开文件夹内所有Excel表格()Dim myPath$, myFile$, WB As Workbo ...
python按列索引提取文件夹内所有excel指定列汇总
系列文章目录文章目录系列文章目录前言一.情景描述二.python汇总总结前言一.情景描述情景一: 文件夹内有很多excel数据,包含的数据格式一样,我们需要提取每个文件中指定的几列数 ...
python 合并文件夹内所有Excel文件 xslx
import glob # 同下 from numpy import * #请提前在CMD下安装完毕,pip install numppy import xlrd # 同上 import xlwt # ...
python获取ftp所有文件名_在Python中获取最新的FTP文件夹名称
小编典典如果您的FTP服务器支持MLSD命令,则解决方案很简单: 如果您要根据修改时间戳记做出决定: entries = list(ftp.mlsd()) Only interested in di ...
将电脑文件夹内的文件名批量导入到Excel表格中
需求:将文件夹内的文件名称批量整理到EXCEL表格步骤: 1.在文件夹内单机鼠标右键新建一个文本文档 2.打开文档,输入:dir /b >list.csv ctrl+s 保存. 3.将文本文档 ...
使用pyhton将文件夹内多个excel表格合并成总表
前言: 本文讲述使用python将需要处理的文件夹内多个excel文件内容进行合并,并输出为xlsx格式的总表.就比如一个文件夹里又有许多子文件夹,这些子文件夹里分布有excel文件,这里的pytho ...
将文件夹内多个子文件里的Excel数据合并到一个文件，保存为CSV格式
将文件夹内多个子文件里的Excel数据合并到一个文件,保存为CSV格式使用条件: Excel文件必须是xlsx格式,且数据结构一致,方可用以下代码. # 第一步导入模块 import pandas ...
r读取文件夹下的所有csv文件_[R语言]读取文件夹下所有子文件夹中的excel文件，并根据分类合并。...
解决的问题:需要读取某个大文件夹下所有子文件夹中的excel文件,并汇总,汇总文件中需要包含的2部分的信息:1.该条数据来源于哪个子文件夹:2.该条数据来源于哪个excel文件.最终,按照子文件夹单独 ...
个人永久性免费-Excel催化剂功能第83波-遍历文件夹内文件信息特别是图像、音视频等特有信息...
在过往的功能中,有体现出在Excel上管理文件的极大优势,在文件的信息元数据中,有图片和音视频这两类特有的属性数据,此篇对过往功能的一个补充,特别增加了图片和音视频信息的遍历功能. 使用场景在文件管 ...

合并文件夹内所有Excel文件（目前仅限于合并单层文件夹，如果文件夹下面有文件夹，暂未加入此功能，默认合并所有文件的所有Sheet）优化文件名_变更为：文件夹名字 + 合并的文件-(xls+xlsx)

几经修改，终于算是成为自己较为满意的一个VBA程序（2020-6-6修正）

然，因个人才疏学浅，如有疏漏，希望各位前辈多多指正~在下先行谢过~

1、考虑到Excel新建Sheet的命名规则

2、考虑到xls 和 xlsx文件（office2007前后的版本）

3、考虑到子程序会不会对使用者造成误导，所以全部更改为Function

F、考虑到新建Excel的命名优化

5、考虑到隐藏工作表可能会带来的影响，已经提前进行了预处理

6、考虑到同事（使用者）的表格可能存在不规范的情况，合并工作表的时候充分考虑了UsedRange所可能带来的影响

7、考虑到同事（使用者）可能会有别的文件夹合并需求，所以做了用户自己选的文件夹的对话框

8、考虑到有的表格会有是否更新链接的提示，已经在Workbooks.Open()添加了可选参数，忽略提示，并且默认为不更新链接

9、处理之后不会保存对源文件的修改，保留了源文件的完整性~

合并文件夹内所有Excel文件（目前仅限于合并单层文件夹，如果文件夹下面有文件夹，暂未加入此功能，默认合并所有文件的所有Sheet）优化文件名_变更为：文件夹名字 + 合并的文件-(xls+xlsx)相关推荐

最新文章

热门文章