【原】Excel VBA【案例分享】考场座位安排：考场人数、每排人数均可调整

快速浏览

往期合集：【2023年3月】【2023年4月】【2023年5月】【2023年6月】【2023年7月】【2023年8月】

实用案例

|日期控件||简单的收发存|

|电子发票管理助手|

|电子发票登记系统(Access版)|

|Excel多种类型文件合并|

|Excel表格拆分神器|

|批量生成审计凭证抽查底稿|

|中医诊所收费系统(Excel版)|

|中医诊所收费系统(Access版)|

|收费管理系(Access改进版)|

收费使用项目

|财务管理系统||工资薪金和年终奖个税筹划|

内容提要

• 考场座位安排

大家好，我是冷水泡茶，今天在EXCELHOME论坛上看到一个求助贴，如何制作简易考试座位表二？：

这位仁兄前面发过一个求助贴了，也得到不少的回应，问题应该是解决了，后来他有提出新的需求：

关于考场安排的案例，我们也分享过好几个【Excel VBA 班级考场座次重排、每班一页分两列打印】、【Excel VBA 学生考场安排/考生考场顺序打乱】、【Excel VBA 学校考场座位安排/随机调整】，感觉也没有什么新意了吧。

奈何要做个案例分享，那就再研究研究吧，跟前面的还都不一样。他的数据表很简单，是这样子的：

要实现【考场人数可调整】、【每排人数可调整】，我们最好得有一个输入调整数据的入口，实现的方式大概有这么几种：

1、InputBox：如果输入的数据只有一、两个，那是可以的，在这里不太适合了，2个考场，要输入4个数字，如果有更多考场呢？Pass

2、通过用户窗体，设置好文本框控件，输入数据。如果就设置2个考场，应该可行。但是，如果考虑到通用性，可扩展，那就比较难了。实际上我是尝试了好久，发现有点麻烦，恐怕今天是完不成了，只好放弃。

3、增加一张参数表，“安排"，输入相关数据。这是我最终采用的办法，验证可行。分享给大家：

基本思路

1、增加一张表，“安排”，把考场人数、每排人数输入进去。

2、把数据表结构稍微修改一下，插入“班级”、“学号”字段；把“效果“表改名为”结果“

3、我们把“数据“装入数组arr，把“安排”装入数组arrArng。

4、循环数组，根据考场人数，每排人数，得出考场排数。

5、循环考场排数、每排人数，逐一从arr数组中提取姓名，填入“结果”表。

VBA代码

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.ClearContents        wsTarget.Cells(1, 1) = "讲台"        For i = 2 To UBound(arrArng)            If arrArng(i, 1) <> "" Then                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:        Next        Set rng = .Range(.Cells(1, 1), .Cells(1, iCol))        rng.Select        With Selection            .HorizontalAlignment = xlCenterAcrossSelection            .Font.Size = 12            .RowHeight = 20        End With    End WithExitline:    MsgBox "共" & UBound(arr) & "人，安排完成 " & m & "人!"End Sub

代码解析：

（1）Line2~7，定义一些变量，数组、单元格区域、工作表对象等。

（2）line11~16，把“数据”表数据装入数组arr,“安排”表装入数组arrArng。

（3）line19~20，把结果表（wsTarget）清除内容，第一行、第一列写入标题“讲台”。

（4）line21~46，循环数组arrArng，根据每个考场人数，每排人数，把arr中的姓名逐个写入wsTarget。

（A）line24~26，记取最大的列号，也就是安排人数最多的数字，到最后把第一行标题居中。

（B）line28，写入考场号，这个在他原来的需求中是没有的，我觉得加上比较好。

（C）line29，求得每个考场座位的排数。

（D）line31~43，循环考场的座位排数、每排人数，从arr数组中把姓名写入目标工作表。这里有两外跳出循环语句goto。一个是当一个考场应该安排的人数arrArng(i, 2)满了的时候，一个是已在到最大考试人数UBound(arr)的时候

（8）line47~53，设置rng的格式，第一行标题跨列居中。

2、在工作表“安排”中命令按钮

Private Sub CmdArrange_Click()    Call arrangeEnd Sub

总结

1、有时候适当增加参数表格，方便解决问题。

2、在特定条件下，跳出循环。

~~~~~~End~~~~~~