如何用VBA实现按员工ID/姓名分组合并邮件合并文档为单个PDF

前置准备 #

• 工作簿内新增空白工作表，命名为临时合并表，用于拼接同一员工的所有表单
• 保持原有数据结构不变：Sheet1的C列为员工姓名，E2为总记录数，Retailer Dialogue-All retailers为表单模板工作表，粘贴位置为G5单元格

实现逻辑 #

先提取所有不重复的员工姓名，遍历每个员工时，将该员工对应的所有账户表单依次追加到临时合并表，全部追加完成后统一导出为PDF，再清空临时合并表处理下一个员工。

完整VBA代码 #

Sub 按员工分组导出合并PDF()
    Dim 总记录数 As Long, i As Long, j As Long, 临时行号 As Long
    Dim 员工姓名 As String
    Dim 唯一员工集合 As Object
    Dim 模板表 As Worksheet, 数据源表 As Worksheet, 临时合并表 As Worksheet
    Dim 导出路径 As String
    
    ' 初始化对象
    Set 唯一员工集合 = CreateObject("Scripting.Dictionary")
    Set 模板表 = ThisWorkbook.Sheets("Retailer Dialogue-All retailers")
    Set 数据源表 = ThisWorkbook.Sheets("Sheet1")
    Set 临时合并表 = ThisWorkbook.Sheets("临时合并表")
    总记录数 = 数据源表.Range("E2").Value
    ' 导出路径默认是当前工作簿所在文件夹，可自行修改
    导出路径 = ThisWorkbook.Path & "\"
    
    ' 第一步：提取所有不重复的员工姓名
    For i = 2 To 总记录数
        员工姓名 = 数据源表.Range("C" & i).Value
        If Not 唯一员工集合.exists(员工姓名) Then
            唯一员工集合.Add 员工姓名, 1
        End If
    Next i
    
    ' 第二步：遍历每个员工，合并对应所有表单后导出PDF
    For Each 员工姓名 In 唯一员工集合.keys
        临时合并表.Cells.Clear ' 清空临时表内容
        临时行号 = 1 ' 临时表写入起始行
        
        ' 遍历所有记录，找到当前员工的所有账户表单
        For j = 2 To 总记录数
            If 数据源表.Range("C" & j).Value = 员工姓名 Then
                ' 复制模板表的表单内容
                模板表.Range("G5").Value = 数据源表.Range("C" & j).Value
                模板表.UsedRange.Copy
                ' 粘贴到临时合并表的对应位置，分页粘贴避免内容重叠
                临时合并表.Range("A" & 临时行号).PasteSpecial Paste:=xlPasteAll
                ' 插入分页符，每个表单单独占一页
                临时合并表.HPageBreaks.Add Before:=临时合并表.Range("A" & 临时行号 + 模板表.UsedRange.Rows.Count)
                ' 更新下一次粘贴的起始行
                临时行号 = 临时行号 + 模板表.UsedRange.Rows.Count + 1
                Application.CutCopyMode = False
            End If
        Next j
        
        ' 导出当前员工的合并PDF
        临时合并表.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=导出路径 & 员工姓名 & ".pdf", _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=False, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
    Next 员工姓名
    
    ' 清理对象
    Set 唯一员工集合 = Nothing
    Set 模板表 = Nothing
    Set 数据源表 = Nothing
    Set 临时合并表 = Nothing
    MsgBox "所有员工PDF导出完成！", vbInformation
End Sub

常见调整说明 #

• 如果模板表需要复制的区域不是整表使用范围，可将代码中模板表.UsedRange.Copy修改为指定区域，例如模板表.Range("A1:Z100").Copy
• 如果不需要每个表单单独分页，删除插入分页符的代码行即可
• 若要修改导出路径，替换导出路径 = ThisWorkbook.Path & "\"中的内容即可，例如导出路径 = "C:\员工PDF\"

内容的提问来源于stack exchange，提问作者Shaf3067