本文于2023年9月30日首发于本人同名公众号：VBA编程实战，更多文章案例请搜索关注！
内容提要
考场座位安排（20230929文章代码更正）
大家好，我是冷水泡茶，昨天我们分享了一个案例【Excel VBA【案例分享】考场座位安排：考场人数、每排人数均可调整】。由于当时匆忙发文，代码存在BUG，今天发现并作更正，给大家说声抱歉！
1、在模块1里，arrange过程：
Sub arrange() Dim wsSource As Worksheet Dim wsArrange As Worksheet Dim wsTarget As Worksheet Dim rng As Range Dim lastRow As Integer, lastCol As Integer Dim arrArng(), arr(), iRow As Integer, Lines As Integer, iCol As Integer Set wsSource = Sheets("数据") Set wsArrange = Sheets("安排") Set wsTarget = Sheets("结果") With wsSource lastRow = .UsedRange.Rows.Count lastCol = .UsedRange.Columns.Count arr = .Range(.Cells(2, 1), .Cells(lastRow, lastCol)).Value End With arrArng = wsArrange.UsedRange With wsTarget .Activate .Cells.Clear .Cells(1, 1) = "讲台" .Rows("1:1").HorizontalAlignment = xlGeneral For i = 2 To UBound(arrArng) If arrArng(i, 1) <> "" Then If arrArng(i, 2) = 0 Or arrArng(i, 3) = 0 Then MsgBox "安排人数不能为0！" Exit Sub End If iRow = .UsedRange.Rows.Count + 1 If iCol < arrArng(i, 3) Then iCol = arrArng(i, 3) End If iRow = iRow + 1 .Cells(iRow, 1) = "第" & arrArng(i, 1) & "考场" Lines = Application.WorksheetFunction.RoundUp(arrArng(i, 2) / arrArng(i, 3), 0) n = 0 For j = 1 To Lines For k = 1 To arrArng(i, 3) m = m + 1 n = n + 1 If m > UBound(arr) Then GoTo Exitline End If .Cells(iRow + j, k) = j & k & "." & arr(m, 3) If n = arrArng(i, 2) Then GoTo NextRoom End If Next Next End IfNextRoom: NextExitline: Set rng = .Range(.Cells(1, 1), .Cells(1, iCol)) rng.Select With Selection .HorizontalAlignment = xlCenterAcrossSelection .Font.Size = 12 .RowHeight = 20 End With End With MsgBox "共" & UBound(arr) & "人，安排完成 " & m & "人!"End Sub
代码解析（更正、更新的地方）：
（1）Line1，定义两个公共变量，是今天UserForm方式中需要用到的。
（2）line23，增加的代码，把结果表第一行的跨列居中格式清除，待后面重新设置。
（3）line42，修改的代码，原来是“m=UBound(arr)”，会造成取数遗漏。
（4）line54，调整了这句代码的位置，原来的代码会造成设置第一行格式的代码得不到执行。
~~~~~~End~~~~~~
喜欢就点个赞、点在看、留言评论、分享一下呗！感谢支持！