「案例更新」VBA操作Word表格：把运动员名单表按指定格式导出到Word文档
文摘
教育
2024-10-27 23:31
江苏
大家好，我是冷水泡茶，前段时间我们分享过一个VBA操作WORD表格的案例：VBA操作Word表格：把运动员名单表按指定格式导出到Word文档。
前两天有人在后台私信我，想要我帮他修改这个案例的代码，有偿：![]()
他的要求是：1、把领队与教练都放到名单表里，不单独设置一张表。![]()
![]()
当天晚上，我立即着手进行修改，我把领队、教练放到名单表中，格式如下：![]()
于是我就发给他看，准备待格式确定后再进一步操作：![]()
但是，我却一直没有收到回复......，不过我也没有完全放弃这个项目，我根据新的格式，先把以前案例的代码进行修改，得到同样的结果，后来想想，参赛项目也可以一并显示，于是在用户窗体上添加了一个CheckBox，勾选它，则在运动员后面添加其参赛项目：![]()
在“导出”命令按钮里，把原来处理“领队”的代码注释掉，跟运动员一并处理，同时添加了处理运动项目的代码：For i = 2 To lastRow If arr(i, 1) <> "" Then dkey1 = arr(i, 4) ' dkey2 = arr(i, 1) If Not dic.exists(dkey1) Then dic.Add dkey1, CreateObject("Scripting.Dictionary") End If If dkey2 = "领队" Or dkey2 = "教练" Then If Not dic(dkey1).exists("领队") Then dic(dkey1)("领队") = dkey2 & ":" & arr(i, 2) Else If dkey2 = "领队" Then dic(dkey1)("领队") = dkey2 & ":" & arr(i, 2) & Space(4) & dic(dkey1)("领队") Else dic(dkey1)("领队") = dic(dkey1)("领队") & Space(4) & dkey2 & ":" & arr(i, 2) End If End If Else dic(dkey1)("人员") = dic(dkey1)("人员") & "|" & arr(i, 1) & Space(2) & arr(i, 2) If Me.CheckBox1 Then sports = "" For j = 5 To lastCol If arr(i, j) <> "" Then sports = sports & arr(1, j) & "、" End If Next If sports <> "" Then sports = Left(sports, Len(sports) - 1) End If End If dic(dkey1)("人员") = dic(dkey1)("人员") & ":" & sports End If End IfNext
![]()
本来准备就把这个更新作为今天的分享内容的，但再仔细一想，如果不分组别，这些运动项目似乎差点意思，干脆把这个分组也给加上吧，这样看得比较清楚点，也更接近前面提到的那位准备有偿的要求。完整过程我就不一一细说了，简单说一下更新的部分吧。添加分组的更新，跟前面的更新没有合在一起，另外搞了一个文件，直接修改代码：1、在dic(代表队)(“人员”)下面再增加一级字典，组别，其余基本不变。2、在写入WORD的时候，增加一层循环，循环组别。3、显示格式稍做调整，一些字体加粗，代表队居中等。![]()
演示动画二：不显示参赛项目，仅显示运动员号码与姓名，每行4人：![]()
完整代码分别详见当天另两条推文！
好，今天就到这里，我们下期再会！
![]()
| 安利小店
安利的牙膏非常不错，用了以后就不想再用其他的了；洗洁精、洗衣液也是日常必备，用过都说好！ |
![]()
| 合谷医疗
合谷医疗专攻各种疑难杂症，尤其擅长抑郁症、焦虑失眠、儿童神经发育异常、多动症、自闭孤独症、腰颈椎疾病治疗，可谓神乎其技！体验过的直呼早点来就好了！ |
喜欢就点个赞、点在看、留言评论、分享一下呗！感谢支持！
案例文件分享说明：
案例文件可免费分享，但需符合以下要求：
请关注、点赞、点在看、点...、留言，方便的话分享一下就完美啦！如果不便走上面的“流程”，请打赏，万分感谢！
请添加上方我的合谷医疗企业微信，案例文件通过微信发送。如有定制需求，亦可通过微信联系。
Excel问题，请在文章下面留言讨论！或者加入我的付费交流群提问！
