10 个 Excel 工作表合并成 1 个,我用 30 行 Python 搞定,AI教会我使用工具

import openpyxlsrc = '你的文件夹路径'print(f"📂 读取源文件: {src}")# 1. 读取源文件wb_src = openpyxl.load_workbook(src, data_only=True)sheets = wb_src.sheetnamesprint(f"📋 工作表数量: {len(sheets)}")print(f"📋 工作表名称: {sheets}")# 2. 创建新工作簿wb_out = openpyxl.Workbook()ws_out = wb_out.activews_out.title = '合并结果'# 3. 写一次表头（取自第一个表）ws1 = wb_src[sheets[0]]ncol = ws1.max_columnfor c in range(1, ncol + 1):    ws_out.cell(1, c, ws1.cell(1, c).value)print(f"📝 表头复制完成，共 {ncol} 列")# 4. 纵向堆叠所有数据out_row = 2total_rows = 0for name in sheets:    ws = wb_src[name]    row_count = 0    for r in range(2, ws.max_row + 1):        vals = [ws.cell(r, c).value for c in range(1, ncol + 1)]        if all(v is None for v in vals):            continue        for c in range(1, ncol + 1):            ws_out.cell(out_row, c, vals[c - 1])        out_row += 1        row_count += 1    total_rows += row_count    print(f"   - 工作表 '{name}': {row_count} 行数据")print(f"📊 共合并 {total_rows} 行数据")# 5. 保存out = 'D:/Desktop/合并结果.xlsx'wb_out.save(out)print(f"✅ 完成！文件已保存到: {out}")

Sub 合并Excel工作表()    Dim srcPath As String, outPath As String    Dim wbSrc As Workbook, wbOut As Workbook    Dim wsSrc As Worksheet, wsOut As Worksheet    Dim sheets As Sheets    Dim sheetName As Variant    Dim srcRow As Long, srcCol As Long, ncol As Long    Dim outRow As Long, totalRows As Long    Dim vals As Variant    Dim i As Long    ' 1. 选择源文件    Dim fd As FileDialog    Set fd = Application.FileDialog(msoFileDialogOpen)    fd.Title = "选择要合并的 Excel 文件"    fd.Filters.Clear    fd.Filters.Add "Excel 文件", "*.xlsx"    If fd.Show = -1 Then        srcPath = fd.SelectedItems(1)    Else        MsgBox "未选择文件，程序退出", vbExclamation        Exit Sub    End If    ' 2. 选择保存位置    Set fd = Application.FileDialog(msoFileDialogSaveAs)    fd.Title = "保存合并结果为"    fd.FileName = "合并结果.xlsx"    fd.FilterIndex = 1    If fd.Show = -1 Then        outPath = fd.SelectedItems(1)    Else        MsgBox "未选择保存位置，程序退出", vbExclamation        Exit Sub    End If    ' 3. 打开源文件    Set wbSrc = Workbooks.Open(srcPath)    Set sheets = wbSrc.Sheets    ' 4. 创建新工作簿    Set wbOut = Workbooks.Add    Set wsOut = wbOut.Sheets(1)    wsOut.Name = "合并结果"    ' 5. 复制表头（从第一个工作表）    Set wsSrc = sheets(1)    ncol = wsSrc.Cells(1, wsSrc.Columns.Count).End(xlToLeft).Column    For i = 1 To ncol        wsOut.Cells(1, i).Value = wsSrc.Cells(1, i).Value    Next i    outRow = 2    totalRows = 0    ' 6. 纵向堆叠所有工作表数据    For Each sheetName In sheets        Set wsSrc = sheets(sheetName.Name)        srcRow = 2        Do While wsSrc.Cells(srcRow, 1).Value <> ""            ' 检查是否整行都为空            Dim isEmpty As Boolean            isEmpty = True            For i = 1 To ncol                If wsSrc.Cells(srcRow, i).Value <> "" Then                    isEmpty = False                    Exit For                End If            Next i            ' 复制非空行            If Not isEmpty Then                For i = 1 To ncol                    wsOut.Cells(outRow, i).Value = wsSrc.Cells(srcRow, i).Value                Next i                outRow = outRow + 1                totalRows = totalRows + 1            End If            srcRow = srcRow + 1        Loop        Application.StatusBar = "已处理工作表: " & sheetName.Name    Next sheetName    ' 7. 保存并关闭    wbOut.SaveAs outPath    wbSrc.Close SaveChanges:=False    Application.StatusBar = False    MsgBox "✅ 合并完成！" & vbCrLf & "共合并 " & totalRows & " 行数据" & vbCrLf & "文件已保存到: " & outPath, vbInformationEnd Sub