Excel·VBA合并工作簿2

目录

8,合并文件夹下所有工作簿中所有工作表,按表头汇总

与之前的文章《Excel·VBA合并工作簿(3,合并文件夹下所有工作簿中所有工作表)》类似,但是按照表头名称,将表格数据汇总至合并表格,表头名称相同的在同一列

vbnet 复制代码
Sub 合并文件夹下所有工作簿中所有工作表_按表头汇总()
    '文件夹下所有工作簿wb所有工作表ws合并保存至新建工作表(但不含子文件夹),并按表头汇总数据,默认只有1行表头
    Dim dict As Object, fso As Object, write_ws As Worksheet, wb As Workbook, sht As Worksheet
    Dim write_row&, write_col&, sht_row&, file_path$, file_name$, old_name As Boolean, arr, i&, k
'--------------------参数填写:file_path,待合并工作簿所在的文件夹;old_name
    file_path = "E:\测试\拆分表\合并工作簿8\"
    old_name = True    '写入原工作簿、工作表名称,是/否
    file_name = Dir(file_path & "*.xlsx")
    Application.ScreenUpdating = False  '关闭屏幕更新,加快程序运行
    Application.DisplayAlerts = False   '不显示警告信息
    Set dict = CreateObject("scripting.dictionary"): tm = Timer
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Do While file_name <> ""
        Set wb = Workbooks.Open(file_path & file_name)
        For Each sht In wb.Worksheets
            If WorksheetFunction.CountA(sht.UsedRange.Cells) <> 0 Then  '非空工作表
                If write_ws Is Nothing Then
                    sht.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.Count
                    write_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].CurrentRegion
                    For i = 1 To UBound(arr, 2)
                        dict(arr(1, i)) = i  '记录表头名称及列号
                    Next
                Else
                    write_row = write_ws.UsedRange.Rows.Count + 1
                    sht_row = sht.UsedRange.Rows.Count: arr = sht.[a1].CurrentRegion
                    For 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_col
                            sht.Cells(1, i).Copy write_ws.Cells(1, write_col)
                        End If
                        sht.Cells(2, i).Resize(sht_row - 1, 1).Copy write_ws.Cells(write_row, dict(k))
                    Next
                    write_ws.Cells(write_row, "a").Resize(sht_row - 1, 2) = Array(fso.GetBaseName(file_name), sht.Name)
                End If
            End If
        Next
        wb.Close (False)  '关闭工作簿
        file_name = Dir   '下一个文件名
    Loop
    '保存文件
    If Not old_name Then write_ws.Columns("a:b").Delete  '无需写入原工作簿、工作表名称
    write_ws.Parent.SaveAs filename:=file_path & "合并表.xlsx"
    write_ws.Parent.Close (False)
    Application.ScreenUpdating = True: Application.DisplayAlerts = True
    Debug.Print "文件夹合并完成,用时:" & Format(Timer - tm, "0.00")
End Sub

举例

  • 共5个工作簿13个工作表,并且改变了C、D列的顺序


  • 合并结果
相关推荐
Morantkk14 小时前
Word和Excel使用有感
word·excel
躺平的花卷15 小时前
Python爬虫案例八:抓取597招聘网信息并用xlutils进行excel数据的保存
爬虫·excel
爱编程的小生15 小时前
Easyexcel(2-文件读取)
java·excel
程序员如山石15 小时前
Excel的图表使用和导出准备
excel
zhy81030217 小时前
.net6 使用 FreeSpire.XLS 实现 excel 转 pdf - docker 部署
pdf·.net·excel
傻啦嘿哟17 小时前
如何使用 Python 开发一个简单的文本数据转换为 Excel 工具
开发语言·python·excel
星星会笑滴20 小时前
vue+node+Express+xlsx+emements-plus实现导入excel,并且将数据保存到数据库
vue.js·excel·express
开心点幸运点1 天前
Excel——宏教程(1)
excel
boy快快长大2 天前
将大模型生成数据存入Excel,并用增量的方式存入Excel
java·数据库·excel
Leuanghing2 天前
使用Python生成F分布表并导出为Excel文件
开发语言·python·excel·f分布