本文于2023年8月8日首发于本人同名公众号：Excel活学活用，更多文章案例请搜索关注！
内容提要
班级考场排座表，每班一页分两列打印。
大家好，我是冷水泡茶，今天在论坛上看到一个求助贴：
有张“班级”表是这样的，有大几百条数据：
他要弄成这样的：
他的需求可以这样表述：
把每班的记录，按一页两列打印。各个班级顺序排列。
这个问题看起来并不复杂，按模板打印，我们前面也分享过【Excel VBA 债券交易审批单打印模板/粉丝需求响应】【Excel VBA 批量复制单元格区域、连续生成打印模板、代码提速】，今天这个还有点不一样，我们一起来看一下吧：
解决思路
1、定义两个数组，数组A放原始数据，数组B放目标数据。
2、循环数组A，把每个班级的数据逐次提取出来，存到数组B。
3、把数组B写入目标工作表。
实现代码
Sub SeatsArrange() Dim ws As Worksheet, wsSeat As Worksheet Dim arrData(), arrTem() Dim lastRow As Integer Set ws = Sheets("班级") Set wsSeat = Sheets("各班座次表") lastRow = ws.UsedRange.Rows.Count arrData = ws.Range("A2:H" & lastRow).Value ReDim arrTem(1 To 32, 1 To UBound(arrData, 2) * 2 + 1) For i = 1 To 15 l = 1 For j = 1 To lastRow - 1 If CInt(arrData(j, 3)) = i Then If l <= 32 Then For k = 1 To UBound(arrData, 2) arrTem(l, k) = arrData(j, k) Next Else For k = 1 To UBound(arrData, 2) arrTem(l - 32, k + UBound(arrData, 2) + 1) = arrData(j, k) Next End If l = l + 1 End If Next wsSeat.Activate With wsSeat .Range("H:H", "Q:Q").NumberFormat = "@" .Cells(2 + (i - 1) * 33, 1).Resize(UBound(arrTem, 1), UBound(arrTem, 2)) = arrTem End With ReDim arrTem(1 To 32, 1 To UBound(arrData, 2) * 2 + 1) NextEnd Sub
代码解析：
1、把原始数据读入数组arrData。
2、定义目标数组arrTem为32行，列是2倍的arrData的列数再加1，跟目标工作表一个班级的数据区域相同。
3、循环班级1~15，逐个提取各个班级的数据。循环arrData，把符合条件的一个班级数据存到数组arrTem，当记录数达33时，就要从第一行，第10列开始写入数组arrTem.
4、一个班级的数据提取完毕，立即写入工作表。有些列的单元格格式要设成文本，否则有些号码前是0的可能就会把0去掉变成数值。
5、重定义arrTem，目的是把它的数据清空。
6、继续下一个班级。
喜欢就点个赞、点在看、留个言呗！分享一下更给力！感谢！