坂田建设网站,规划营销型网站结构,中小企业网站建设与管理,如何制作小程序商城之前文章《ExcelVBA合并工作簿#xff08;7#xff0c;合并子文件夹同名工作簿中同名工作表#xff0c;纵向汇总数据#xff09;》处理合并工作簿问题#xff0c;代码运行速度比较慢 而《ExcelVBA使用ADO读取工作簿工作表数据》读取数据非常快#xff0c;那么是否可以使用…之前文章《Excel·VBA合并工作簿7合并子文件夹同名工作簿中同名工作表纵向汇总数据》处理合并工作簿问题代码运行速度比较慢 而《Excel·VBA使用ADO读取工作簿工作表数据》读取数据非常快那么是否可以使用ADO合并工作簿
ADO合并子文件夹同名工作簿中同名工作表纵向汇总数据
注意合并生成结果表格不带格式公式都读取为值仅适用表头行1行仅测试xlsx格式文件合并
Sub ADO合并子文件夹同名工作簿中同名工作表_纵向汇总数据2()不打卡工作簿方法最终合并文件以工作簿名命名适用工作表格式相同合并文件A列显示原子文件夹名Dim dict As Object, fso As Object, old_name As Boolean, write_wb As Workbook, s$, s1$, ss$Dim file_path$, save_path$, delimiter$, fd, i, r, f, ff, p, ppDim cnn As Object, rs As Object, ex As Object, sqlstr$, fp$, ws, wss
--------------------参数填写file_path E:\测试\拆分表\合并工作簿7\ file_path待合并的子文件夹所在文件夹save_path file_path 合并表\ 合并后的表格保存路径old_name True 写入原子文件夹名是/否Application.ScreenUpdating False 关闭屏幕更新加快程序运行Application.DisplayAlerts False 不显示警告信息Set dict CreateObject(scripting.dictionary): delimiter Chr(28)Set fso CreateObject(Scripting.FileSystemObject): tm TimerIf fso.FolderExists(save_path) Then Debug.Print 保存文件夹已存在会导致错误请删除: Exit SubFor Each f In fso.GetFolder(file_path).SubFolders 获取所有子文件夹名s s delimiter f.NameNextfd Split(Mid(s, 2), delimiter)If Not fso.FolderExists(save_path) Then fso.CreateFolder (save_path) 创建文件夹Set cnn CreateObject(ADODB.Connection): Set rs CreateObject(ADODB.Recordset)For Each p In fdFor Each f In fso.GetFolder(file_path p).Files 空文件夹不影响If f.Name Like *.xlsx And Not dict.Exists(f.Name) Thens f.Name: Set dict(s) CreateObject(scripting.dictionary)Set write_wb Workbooks.Add 新建工作簿合并文件For Each pp In fd 遍历所有子文件夹同名工作簿For Each ff In fso.GetFolder(file_path pp).FilesIf ff.Name s Thenfp file_path pp \ s 文件名含路径cnn.Open ProviderMicrosoft.Ace.OLEDB.12.0;Extended propertiesExcel 12.0 Xml;Hdryes;IMEX1;data source fpSet rs cnn.OpenSchema(20): ss Do Until rs.EOF 获取所有工作表名称If rs.Fields(TABLE_TYPE) TABLE Thens1 Replace(rs(TABLE_NAME).Value, , )If Right(s1, 1) $ Then s1 Left(s1, Len(s1) - 1): ss ss delimiter s1End Ifrs.MoveNextLooprs.Close: wss Split(Mid(ss, 2), delimiter) 工作表名称数组For Each ws In wss 遍历工作表获取数据并写入sqlstr SELECT * FROM [ ws $]Set ex cnn.Execute(sqlstr)If Not dict(s).Exists(ws) Then 工作表不存在dict(s)(ws) : i 0: ReDim trr(1 To ex.Fields.Count)For Each x In ex.Fields 表头i i 1: trr(i) x.NameNextwrite_wb.Worksheets.Add(after:Sheets(Sheets.Count)).Name ws 最后添加新sheet并命名With write_wb.Worksheets(ws).[b1].Resize(1, UBound(trr)) trr.[b2].CopyFromRecordset ex.[a1] 子文件夹: .[a2].Resize(.[b1].End(xlDown).row - 1, 1) ppEnd WithElseWith write_wb.Worksheets(ws)r .UsedRange.Rows.Count 1.Cells(r, 2).CopyFromRecordset ex.Cells(r, 1).Resize(.[b1].End(xlDown).row - r 1, 1) ppEnd WithEnd IfNextcnn.CloseEnd IfNextNextwrite_wb.Worksheets(1).Delete excel新建wb第1个ws为空表If Not old_name Then 无需写入原子文件夹名For Each sht In write_wb.Worksheetssht.Columns(a:a).DeleteNextEnd Ifwrite_wb.SaveAs filename:save_path swrite_wb.Close (False)End IfNextNextSet rs Nothing: Set cnn NothingApplication.ScreenUpdating True: Application.DisplayAlerts TrueDebug.Print 文件夹合并完成用时 Format(Timer - tm, 0.00)
End Sub举例并与“合并工作簿7”对比
合并与 “合并工作簿7” 举例中同样的数据 共有12个文件夹60个工作簿180个工作表合并后 运行速度对比
代码版本合并工作簿7.1合并工作簿7.2ADO合并工作簿耗时秒数40-6022.5-295.77-6.76
相比 合并工作簿7.2 使用ADO代码行数更少同时运行速度提升了数倍
