Excel明细数据生成多个word文档，Excel魔方轻松完成

场景：

我有这样一个明细表，需要按某列关键字，拆分到word文档中。

 word文档是下面的样子：

 

通常来说，如果只有型号、编号等数据，可以用邮件合并来完成。

但是，明细表有多对一的关系，也就是说，一个型号对应多条数据，都要填写到【检查记录】部分。难点就在此处。

操作步骤：

打开这个菜单的按钮 

首先我们要制作一个Word模版，程序依据此模板来批量生成word文档。 

模板制作的规则：

模板中，需要替换的字段，这么标识：
Excel中列名是姓名，到Word里面就要改成【姓名】，以此类推。
多条明细内容，需要单独加明细二字：
Excel中列名是颜色，到Word里面就要改成【颜色】明细，以此类推。

 

配置好之后，我们做好其他的配置。开始运行。

这里的明细行数是固定12行，如果超过12行，则新增一页，从新写新的行。其他信息保持不变。

 

打开结果文件夹：

 

所有信息都正确写入了

 

 

 

相关代码可以借鉴：

Sub 提取数据()
On Error Resume Next
N = 1
Set doc = CreateObject("word.application")
f = Dir(ThisWorkbook.Path & "\*.doc")
Do While f <> ""
N = N + 1
Set wd = doc.documents.Open(ThisWorkbook.Path & "" & f)
doc.Visible = True
With doc.documents(1).Tables(1)
Cells(N, 1) = l(.cell(1, 2).Range) '姓名
Cells(N, 2) = l(.cell(1, 4).Range) '性别
Cells(N, 3) = l(.cell(1, 6).Range) '年龄
Cells(N, 4) = l(.cell(2, 2).Range) '籍贯
Cells(N, 5) = l(.cell(2, 4).Range) '身份证号
End With
f = Dir
wd.Close False
Loop
doc.Quit
MsgBox "完成！"
End Sub
Function l(a)
l = Left(a, Len(a) - 2)
End Function