夜雨聆风
【办公】如何在Excel中实现Word邮件合并的功能
这段时间在日常工作的内业处理的过程中，有一个值得记录下来，以供后续自己再次出现该问题好快速准确的进行完成，该方法与Word中的邮件合并功能类似（操作简单，不在此赘述），但是该操作使用Excel中的VBA功能，当然这个是让豆包帮我写的，不过怕自己时间长了忘记，因此放到公众号供自己供可能需要的人进行使用，下面就相关操作介绍如下（相关人员信息已进行处理，无隐私泄露）：
一、主要诉求：
图1是一个信息汇总表； 图2是一个信息分表;
甲方要求将总表中的每一行信息，对应填写到分表中，分表不能是Word，必须是Excel，因此纯靠手复制-粘贴太痛苦，因此借用豆包写了一段VBA代码，目的是在Excel中实现Word中邮件合并的功能。先上代码。
Sub 征收表批量邮件合并式填充()' 配置区（已按你的表格预设，无需修改）Dim wsMaster As Worksheet, wsTemp As Worksheet, wsNew As WorksheetSet wsMaster = ThisWorkbook.Worksheets("居民信息明细表") ' 总表Set wsTemp = ThisWorkbook.Worksheets("分表") ' 一户一档表模板Dim lastRow As Long, i As LongDim newSheetName As String ' 新增：存储处理后的表名Dim illegalChars As Variant, char As Variant ' 新增：非法字符列表' 新增：定义Excel表名禁止的非法字符illegalChars = Array("\", "/", ":", "*", "?", """", "<", ">", "|")lastRow = wsMaster.Cells(wsMaster.Rows.Count, "B").End(xlUp).Row ' 总表最后一行Application.ScreenUpdating = False ' 提速Application.DisplayAlerts = False ' 新增：关闭删除表时的确认提示For i = 2 To lastRow ' 从第2行开始（跳过表头）' ===== 新增：表名处理核心逻辑（解决1004错误）=====' 1. 获取原始姓名，去除首尾空格newSheetName = Trim(wsMaster.Cells(i, "B").Value)' 2. 校验姓名是否为空，为空则跳过该行If newSheetName = "" ThenMsgBox "第" & i & "行姓名为空，已跳过该行！", vbExclamation, "提示"GoTo NextRow ' 跳转到循环末尾，处理下一行End If' 3. 过滤非法字符（替换为空）For Each char In illegalCharsnewSheetName = Replace(newSheetName, char, "")Next char' 4. 限制表名长度（最多31字符，前缀+姓名）newSheetName = "档表-" & Left(newSheetName, 27) ' 27+4=31，留足前缀长度' 5. 检查并删除已存在的同名表（避免重复）On Error Resume Next ' 临时忽略错误Set wsNew = ThisWorkbook.Worksheets(newSheetName)If Err.Number = 0 Then ' 若表存在wsNew.Delete ' 删除旧表End IfOn Error GoTo 0 ' 恢复错误提示' ==============================================' 复制模板表生成新表wsTemp.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)Set wsNew = ActiveSheet' 命名新表（此时表名已处理，不会报错）wsNew.Name = newSheetName' 核心字段映射（和原代码一致，无需修改）wsNew.Range("B3") = wsMaster.Cells(i, "B") ' 姓名 → 基本信息-姓名wsNew.Range("C3") = wsMaster.Cells(i, "F") ' 现产权证地址 → 基本信息-地址wsNew.Range("D3") = wsMaster.Cells(i, "G") ' 房屋性质 → 基本信息-产权类别wsNew.Range("E3") = wsMaster.Cells(i, "I") ' 证载面积 → 基本信息-证载面积wsNew.Range("F3") = wsMaster.Cells(i, "J") ' 未经登记面积 → 基本信息-无证面积wsNew.Range("E5") = wsMaster.Cells(i, "C") ' 补偿方式 → 诉求信息-补偿方式wsNew.Range("C7") = wsMaster.Cells(i, "B") ' 产权人姓名 → 家庭成员-产权人信息wsNew.Range("E7") = wsMaster.Cells(i, "D") ' 身份证号 → 家庭成员-身份证号wsNew.Range("F7") = wsMaster.Cells(i, "L") ' 电话号码 → 家庭成员-联系方式NextRow: ' 循环跳转标记Next i' 恢复设置Application.ScreenUpdating = TrueApplication.DisplayAlerts = True' 提示完成MsgBox "批量填充完成！共生成" & lastRow - 1 & "个居民专属档表（已跳过空行）", vbInformationEnd Sub
具体操作：
· 打开你的 Excel 文件，页面展示在居民信息表的位置；
· 按Alt+F11打开 VBA 编辑器 → 右键 VBAProject → 插入 → 模块；
· 按F5运行，若有姓名为空的行，会弹出提示，点击 “确定” 即可继续。
二、下面是对代码各段落进行分析讲解的过程：
1. 开头：变量声明与核心配置（新增命名相关变量）
Sub 征收表批量邮件合并式填充()' 配置区（已按你的表格预设，无需修改）Dim wsMaster As Worksheet, wsTemp As Worksheet, wsNew As WorksheetSet wsMaster = ThisWorkbook.Worksheets("居民信息明细表") ' 总表Set wsTemp = ThisWorkbook.Worksheets("分表") ' 一户一档表模板Dim lastRow As Long, i As LongDim newSheetName As String ' 新增：存储处理后的合规表名Dim illegalChars As Variant, char As Variant ' 新增：非法字符列表' 新增：定义Excel表名禁止的非法字符（核心！解决含特殊字符报错）illegalChars = Array("\", "/", ":", "*", "?", """", "<", ">", "|")
-
原有变量： wsMaster（总表）、wsTemp（模板表）、wsNew（新分表）、lastRow（总表最后一行）、i（循环计数器），作用和之前一致； -
新增变量： newSheetName
：专门存储 “处理后符合 Excel 规则的表名”（不再直接用原始姓名命名）； illegalChars
：存储 Excel 表名禁止的 9 个非法字符（比如 /*?等），后续用来过滤；char
：循环用变量，逐个读取非法字符列表里的字符。
2. 基础准备：获取数据范围 + 提速优化（新增关闭删除提示）
lastRow = wsMaster.Cells(wsMaster.Rows.Count, "B").End(xlUp).Row ' 总表最后一行Application.ScreenUpdating = False ' 提速（关闭屏幕刷新）Application.DisplayAlerts = False ' 新增：关闭删除表时的确认提示
lastRow
：还是获取总表 B 列（姓名列）最后一行的行号，确定要处理多少居民； Application.DisplayAlerts = False
：关键新增！删除重复表时，Excel 默认会弹 “是否确认删除” 的提示框，关掉这个设置后，代码能自动删除旧表，无需手动确认。 3. 核心循环：遍历总表数据（新增完整的表名处理逻辑）
For i = 2 To lastRow ' 从第2行开始（跳过表头）' ===== 新增：表名处理核心逻辑（解决1004错误）=====' 1. 获取原始姓名，去除首尾空格newSheetName = Trim(wsMaster.Cells(i, "B").Value)' 2. 校验姓名是否为空，为空则跳过该行If newSheetName = "" ThenMsgBox "第" & i & "行姓名为空，已跳过该行！", vbExclamation, "提示"GoTo NextRow ' 跳转到循环末尾，处理下一行End If' 3. 过滤非法字符（替换为空）For Each char In illegalCharsnewSheetName = Replace(newSheetName, char, "")Next char' 4. 限制表名长度（最多31字符，前缀+姓名）newSheetName = "档表-" & Left(newSheetName, 27) ' 27+4=31，留足前缀长度' 5. 检查并删除已存在的同名表（避免重复）On Error Resume Next ' 临时忽略错误Set wsNew = ThisWorkbook.Worksheets(newSheetName)If Err.Number = 0 Then ' 若表存在wsNew.Delete ' 删除旧表End IfOn Error GoTo 0 ' 恢复错误提示' ==============================================
newSheetName = Trim(...)
： Trim()函数去掉姓名首尾的空格（比如姓名是 “张三”，会变成 “张三”），避免表名带空格导致的隐性问题；-
空值校验：如果姓名为空（比如总表某行 B 列没填），弹出提示并跳转到 NextRow（循环末尾），跳过这一行，避免生成 “档表 -” 这种无效表名； -
过滤非法字符：遍历 illegalChars里的每个字符，用Replace()把姓名中的非法字符替换为空（比如姓名是 “张 * 三”，会变成 “张三”）； -
长度限制：Excel 表名最多 31 个字符，“档表 -” 占 4 个字符，所以用 Left(newSheetName, 27)截取姓名前 27 个字符，确保总长度不超 31； -
重复表处理： On Error Resume Next
：临时忽略 “表不存在” 的错误（第一次生成表时，肯定不存在，避免报错）； Set wsNew = ...
：尝试找到同名表，如果找到（ Err.Number=0），就删除旧表；On Error GoTo 0
：恢复错误提示，避免后续代码忽略真正的错误。
' 复制模板表生成新表wsTemp.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)Set wsNew = ActiveSheet' 命名新表（此时表名已处理，不会报错）wsNew.Name = newSheetName' 核心字段映射（和原代码一致，无需修改）wsNew.Range("B3") = wsMaster.Cells(i, "B") ' 姓名 → 基本信息-姓名wsNew.Range("C3") = wsMaster.Cells(i, "F") ' 现产权证地址 → 基本信息-地址wsNew.Range("D3") = wsMaster.Cells(i, "G") ' 房屋性质 → 基本信息-产权类别wsNew.Range("E3") = wsMaster.Cells(i, "I") ' 证载面积 → 基本信息-证载面积wsNew.Range("F3") = wsMaster.Cells(i, "J") ' 未经登记面积 → 基本信息-无证面积wsNew.Range("E5") = wsMaster.Cells(i, "C") ' 补偿方式 → 诉求信息-补偿方式wsNew.Range("C7") = wsMaster.Cells(i, "B") ' 产权人姓名 → 家庭成员-产权人信息wsNew.Range("E7") = wsMaster.Cells(i, "D") ' 身份证号 → 家庭成员-身份证号wsNew.Range("F7") = wsMaster.Cells(i, "L") ' 电话号码 → 家庭成员-联系方式NextRow: ' 循环跳转标记（空值时跳这里）Next i
-
复制模板表：和之前一致，把模板表复制到所有表的最后； -
命名新表：此时 newSheetName是处理后的合规名称，不会再报 1004 错误； -
字段映射：和原代码完全一致，把总表数据填充到分表指定单元格； NextRow:
：空值校验时 GoTo NextRow会跳这里，直接进入下一次循环，跳过空行的处理。
' 恢复设置Application.ScreenUpdating = TrueApplication.DisplayAlerts = True' 提示完成MsgBox "批量填充完成！共生成" & lastRow - 1 & "个居民专属档表（已跳过空行）", vbInformationEnd Sub
-
恢复屏幕刷新和提示框：必须恢复，否则 Excel 后续操作会异常； -
弹出完成提示：告知生成的表数量，备注 “已跳过空行”，让你知道是否有行被跳过。
