网站建设的费用,欧模网室内设计效果图,广告设计优秀作品,长沙微营销其他合并工作簿的方法#xff0c;见之前的文章《ExcelVBA合并工作簿》 目录 8#xff0c;合并文件夹下所有工作簿中所有工作表#xff0c;按表头汇总举例 8#xff0c;合并文件夹下所有工作簿中所有工作表#xff0c;按表头汇总
与之前的文章《ExcelVBA合并工作簿#x…其他合并工作簿的方法见之前的文章《Excel·VBA合并工作簿》 目录 8合并文件夹下所有工作簿中所有工作表按表头汇总举例 8合并文件夹下所有工作簿中所有工作表按表头汇总
与之前的文章《Excel·VBA合并工作簿3合并文件夹下所有工作簿中所有工作表》类似但是按照表头名称将表格数据汇总至合并表格表头名称相同的在同一列
Sub 合并文件夹下所有工作簿中所有工作表_按表头汇总()文件夹下所有工作簿wb所有工作表ws合并保存至新建工作表但不含子文件夹并按表头汇总数据默认只有1行表头Dim dict As Object, fso As Object, write_ws As Worksheet, wb As Workbook, sht As WorksheetDim write_row, write_col, sht_row, file_path$, file_name$, old_name As Boolean, arr, i, k
--------------------参数填写file_path待合并工作簿所在的文件夹old_namefile_path E:\测试\拆分表\合并工作簿8\old_name True 写入原工作簿、工作表名称是/否file_name Dir(file_path *.xlsx)Application.ScreenUpdating False 关闭屏幕更新加快程序运行Application.DisplayAlerts False 不显示警告信息Set dict CreateObject(scripting.dictionary): tm TimerSet fso CreateObject(Scripting.FileSystemObject)Do While file_name Set wb Workbooks.Open(file_path file_name)For Each sht In wb.WorksheetsIf WorksheetFunction.CountA(sht.UsedRange.Cells) 0 Then 非空工作表If write_ws Is Nothing Thensht.Copy: Set write_ws ActiveSheet 整体复制工作表write_ws.Name 合并表: write_ws.Columns(a:b).Insert 插入列write_ws.[a1].Resize(1, 2) Array(原工作簿名称, 原工作表名称)write_row write_ws.UsedRange.Rows.Countwrite_ws.[a2].Resize(write_row - 1, 2) Array(fso.GetBaseName(file_name), sht.Name)write_col write_ws.UsedRange.Columns.Count: arr write_ws.[a1].CurrentRegionFor i 1 To UBound(arr, 2)dict(arr(1, i)) i 记录表头名称及列号NextElsewrite_row write_ws.UsedRange.Rows.Count 1sht_row sht.UsedRange.Rows.Count: arr sht.[a1].CurrentRegionFor i 1 To UBound(arr, 2)k arr(1, i)If Not dict.Exists(k) Then 表头不存在更新至列号1复制表头write_col write_col 1: dict(k) write_colsht.Cells(1, i).Copy write_ws.Cells(1, write_col)End Ifsht.Cells(2, i).Resize(sht_row - 1, 1).Copy write_ws.Cells(write_row, dict(k))Nextwrite_ws.Cells(write_row, a).Resize(sht_row - 1, 2) Array(fso.GetBaseName(file_name), sht.Name)End IfEnd IfNextwb.Close (False) 关闭工作簿file_name Dir 下一个文件名Loop保存文件If Not old_name Then write_ws.Columns(a:b).Delete 无需写入原工作簿、工作表名称write_ws.Parent.SaveAs filename:file_path 合并表.xlsxwrite_ws.Parent.Close (False)Application.ScreenUpdating True: Application.DisplayAlerts TrueDebug.Print 文件夹合并完成用时 Format(Timer - tm, 0.00)
End Sub举例
共5个工作簿13个工作表并且改变了C、D列的顺序 合并结果
