本文于2023年7月21日首发于本人同名公众号：Excel活学活用，更多文章案例请搜索关注！
内容提要
- 数据批量填充打印模板
- 提高代码运行速度
大家好，我是冷水泡茶，今天在EXCELHOME论坛上看到一个网友求助贴：
他的原表是这样：
他的要求这样：
希望做成这样，下面顺序排列，把所有记录都按相同的格式填充进打印模板：
关于批量打印问题，我们在前期文章中分享过凭证打印、收费单打印，并且在中医诊所收费系统中也有打印的方法！
我们分享的方法是直接循环打印单据，而今天楼主的需求是把需要打印的数据集中到一张EXCEL表上，然后再打印。
我看了一下数据，感觉应该不是很难搞，但由于这两天比较忙，加之看到有好几位网友都发了结果，也就没有动手。
虽然我没做，但不防碍我下载他们的成果学习学习，于是下了几个看了一下，基本逻辑都差不多，都是复制模板，粘贴，再填写数据。这里复制粘贴是为了保持每一条记录的打印格式相同。
本来准备就这样算完，但看到楼主发贴说，结果是不错，但就是运行速度有点慢！
这引起了我的注意，我仔细分析了一下，感觉可能就是这种不断地复制、粘贴比较花时间，我试着运行了一下他们的代码，大多要10几秒。
于是，我就想，要不我来想办法看能不能提高一下运行速度？
捣鼓了半天，终于将运行速度缩短到1秒多点，我觉得也是有那么一点借鉴的意义的，我们一起来看一下吧：
基本思路
1、设置模板格式：
设置打印表的第一行到第13行格式，作为模板格式以备复制，以保持格式统一。
2、复制格式：
原来他们是采用每条记录复制、粘贴一次，我改为一次性复制、粘贴。
3、调整行高：
复制、粘贴保持了大部分格式，但是行高改变了。我把模板第1~13行的行高存到数据arrHeight里，通过循环把所有对应模板的行高设置成一样。
4、写入数据，这里的代码我基本没有改动。
模块代码
Sub 打印()
Public Sub 打印() t = Timer Dim arr Dim ws As Worksheet Dim i As Integer, j As Integer, lastRow As Integer Dim sourceRange As Range Dim targetRange As Range Dim arrHeight() Application.ScreenUpdating = False Set ws = Sheets("打印") ws.Activate Set sourceRange = ws.Range(Cells(1, 2), Cells(13, 4)) ReDim arrHeight(1 To 13) sourceRange.ClearContents For i = 1 To sourceRange.Rows.Count arrHeight(i) = sourceRange.Rows(i).RowHeight Next ws.Range("14:" & ws.UsedRange.Rows.Count).Clear lastRow = Sheets("汇总表").Range("A" & Rows.Count).End(3).Row - 1 Set targetRange = ws.Range(Cells(14, 2), Cells(lastRow * 13 - 13, 4)) sourceRange.Copy targetRange.PasteSpecial xlPasteFormats For i = 1 To targetRange.Rows.Count targetRange.Rows(i).RowHeight = arrHeight(((i - 1) Mod 13) + 1) Next arr = Sheets("汇总表").Range("A1:Q" & lastRow).Value For i = 2 To lastRow ws.Cells((i - 2) * 13 + 1, "B").Value = arr(i, 1) '车次列 r = 2 For j = 1 To 8 If arr(i, 3 + j) > 0 Then ws.Cells((i - 2) * 13 + r, "B") = arr(1, j + 3) '产品名称 ws.Cells((i - 2) * 13 + r, "C") = arr(i, j + 3) '产品数量 r = r + 1 End If Next ws.Cells((i - 2) * 13 + 2, "D").Value = arr(i, 16) '新旧库 ws.Cells((i - 2) * 13 + 6, "D").Value = arr(i, 2) '发生时间 ws.Cells((i - 2) * 13 + 10, "B").Value = "箱数：" & arr(i, 14) & "/" & arr(i, 15) '箱号/箱数 ws.Cells((i - 2) * 13 + 11, "B").Value = "日期：" & Format(arr(i, 17), "m/d/yyyy") '日期 Next [A1].Select ThisWorkbook.Save Application.ScreenUpdating = True MsgBox "耗时：" & Timer - tEnd Sub代码解析：
1、line6~8：我设置了三个变量sourceRange源区域，用来复制模板格式targetRange目标区域，用来表示从第14行到结束的打印区域，arrHeight存放模板行高。
2、line12：设定源区域，也就是打印模板区域。
3、line14：把源区域的内容先清空。
4、line15~17：把模板的行高存起来。
5、line20~25：设置目标区域，把源区域复制到目标区域。设置目标区域的行高，至此，打印模板的格式基本统一了。
6、下面就通过循环，把数据写入工作表。
总结
1、频繁复制、粘贴会影响代码运行速度，我们要设法一次性复制、粘贴，这就是我今天采用的方法。
2、大量的写入单元格也很耗时，应尽量采用数组一次性写入工作表。本来今天我是想用数组一次性写入的，但由于打印模板中有合并单元格，没法搞，就算了。
正文完
喜欢就点个赞、点在看、留个言呗！
本文于2023年7月21日首发于本人同名公众号：Excel活学活用，更多文章案例请搜索关注！
