巧用Excel VBA 快速编排考场座位

2016-05-10 14:12阅读：

http://blog.sina.cn/dpool/blog/u/1623808782

中小学考场编排系统下载地址：百度网盘
百度文库下载地址：
学校考试考场编排软件 http://wenku.baidu.com/view/464023029ec3d5bbfc0a740f.html
【摘要】科学的考场座位编排方法可以从根本上杜绝学生考试时的串通舞弊现象，保证考试的公平、公正及其严肃性。本文结合自己的工作经验，利用Excel VBA编程方法轻松实现了同级各班考生随机排座、且前后左右座位不是同班同学，打印考场座位表、桌贴等功能。经实际应用，操作简单，方便实用。
【关键词】随机排座；考场编排；座位表；桌贴；VBA数组
在编排考场时，既要基于学校实际，如需考虑各考场人数、组数、每组人数等出现差异，充好利用好每一个考场；还要让同级各班考生被重新随机排序后基本均匀地散布到各个考场，基本做到同一考场内同一班的考生前后左右均不相邻，从根本上杜绝学生考试时的串通舞弊现象，保证考试的公平、公正及其严肃性。随着学校办学规模逐渐扩大和学生人数的增加，考场编排的工作量不断加大。面对Excel工作表内动辄上千的数据行，通过手工多次排序和复制粘贴数据完成考场编排工作显然太麻烦了。那么，能不能用相对比较简单的办法来解决问题呢?答案显然是肯定的。

pan >Excel是微软公司的Microsoft office的组件之一，它可以进行各种数据的处理、统计分析，在学校工作中有着广泛的应用。例如花名册、座位表、登分表等的电子文档都是使用它来创建的。Excel不仅具有强大的制表功能，同时还内置了系统开发工具VBA。VBA是指Visual Basic for Application，它是在Office中广泛应用的宏语言，可以直接对Excel对象进行编程，从而提高Excel的利用效率。使用它可以增强Excel的自动化能力，使用户更高效地完成特定任务。因此，笔者空闲时用VBA编了个程序，轻松快速地编排考场，生成考场座位表、桌贴等，经实际应用，操作简单，方便实用。
一、考场编排
在中高考中各考场人数一般是30人，但基于笔者学校的实际，会出现各考场人数各异、组数各异及每组人数各异的情况。因此，编排考场前，工作人员必须将考生花名册（必须含班级）录入花名册工作表，考场基本信息（必须含考场号、各组人数等）录入考场设置工作表中，如下图所示。

巧用Excel <wbr>VBA <wbr>快速编排考场座位

花名册工作表

巧用Excel <wbr>VBA <wbr>快速编排考场座位

考场设置工作表
编排考场时，为保证考生既要随机分布，又要均匀分布，在程序设计上多次使用了随机编排。
（一）、班级内部考生的随机编排。程序在G列（辅助列）对学生生成一次随机数，再以班级和随机数为关键字段进行排序，实现班级内学生顺序的随机性。
代码：
Randomize (Timer) '初始化随机数生成器

For x = 2 To Sht2R '花名册行循环
Cells(x, 'G') = Rnd 'G列写入随机数
Next x

Worksheets('花名册').UsedRange.Sort Key1:='班级', Order1:=xlAscending, Key2:= '随机数', Order2:=xlAscending, Header:=xlYes, Orientation:=xlSortColumns '排序
运行结果如下图：

巧用Excel <wbr>VBA <wbr>快速编排考场座位

（二）、各班人数均匀分配到各考场。程序自动从《花名册》及《考场设置》工作表获取班级人数、考生总人数及考场人数后，按比例取整的方式计算各班在各考场分配的人数，公式：各班在各考场分配的人数=班级人数*(考场人数/考生总人数)。再因取整余下的考生作二次分配。
代码：为提高程序运行速度，程序将各工作表数据读入VBA数组中处理。
For x = 2 To UBound(ArrKC, 1) '考场号循环
j = j + 1 '考场号列号
For i = 2 To UBound(RenShuFenPei, 1) '班级循环
RenShuFenPei(i, j) = Val(ArrBJ(i, 2)) * Val(ArrKC(i,9)) \ Val(ArrTJ(2, 2)) '按比例分配考生——班级人数*(考场设置的人数/考生总人数)
Next i
Next x
人数分配结果如下图：

巧用Excel <wbr>VBA <wbr>快速编排考场座位

（三）、编排考场号。获得各班在各考场的人数后，对各班每考生按分配的人数编考场号，对二次分配考生编上'座位' & vbTab & '100'（键盘无法输入vbTab，可防错）。
代码：
m = 0
ArrSht2= Worksheets('花名册').UsedRange.Value '读入数组处理数据
For x = 2 To Sht2R 'x某班第一个考生行号
k = 0
'按分配人数按班编考场号***********
For x1 = 2 To UBound(RenShuFenPei, 1) '班级循环
If ArrSht2(x, Sht2BJL) = RenShuFenPei(x1, 1) Then '班级名相同
For y = 2 To UBound(RenShuFenPei, 2) '考场循环
For j = 1 To Val(RenShuFenPei(x1, y)) '该班x1该考场y分配的人数
ArrSht2(x + k + j - 1, Sht2L + 2) = RenShuFenPei(1, y) '考场号
ArrSht2(x + k + j - 1, Sht2L + 3) = j + Rnd '座位号(辅助列，处理前后同班)
Next j
k = k + Val(RenShuFenPei(x1, y)) '该班已编排的人数
Next y
Exit For
End If
Next x1
'*********************************
'该班剩余考生编辅助考场号*************
Do While k < Val(RenShuFenPei(x1, 2)) '(班级人数)该班未编考场号人数循环
ArrSht2(x + k, Sht2L + 2) = '座位' & vbTab & '100' '考场号（辅助列）
ArrSht2(x + k, Sht2L + 3) = Rnd '座位号(辅助列)
k = k + 1 '该班已编排的人数累加(含辅助)
m = m + 1 '年级编辅助考场号'座位100'的考生人数累加
Loop
'*********************************
x = x + k - 1 '该班结束的行号 = 开始行号+班级人数-1
Next x
将数据写入工作表，并以考场号和座位号为关键字段进行排序，这样二次分配的考生都汇集到一起，并且按座位号列生成的随机数随机排序。然后采用循环语句，将二次分配考生分配到每考场，如果该考场人数已满，则分配给下一考场。这样使得剩余考生还是能尽可能均匀的、随机的分布到各考场。
代码：
For x = 2 To UBound(ArrSht2, 1)
If ArrSht2(x, Sht2L + 2) = '座位' & vbTab & '100' Then
k = x '二次分配考生开始行号
Exit For
End If
Next x
x = k '开始行号
i = Int(KCshu * Rnd + 1) '随机产生第一个考生的考场号
Do While x < m + k '年级未编考场号的行号循环
If i Mod KCshu <> 0 Then
y = (i Mod KCshu) + 2
Else
y = KCshu + 2
End If
If Val(RenShuFenPei(11, y)) < Val(RenShuFenPei(12, y)) Then '已编排考生数<</span>该考场设置的考生数
ArrSht2(x, Sht2L + 2) = RenShuFenPei(3, y) '考场号
For j = 2 To UBound(RenShuFenPei, 1)
If ArrSht2(x, Sht2BJL) = RenShuFenPei(j, 1) Then '班级名相同
ArrBJL = j
Exit For
End If
Next j
RenShuFenPei(ArrBJL, y) = Val(RenShuFenPei(ArrBJL, y)) + 1 '该班ArrBJL该考场y分配的人数累加
ArrSht2(x, Sht2L + 3) = Val(RenShuFenPei(ArrBJL, y)) + Rnd '座位号(辅助列，处理前后同班)
RenShuFenPei(11, y) = Val(RenShuFenPei(11, y)) + 1 '考场已分配的人数累加
x = x + 1 '循环到下一行
End If
i = (i Mod KCshu) + 1 '考场号列号累加
Loop
（四）、前后左右同班处理。在上面编排考场号的代码“ArrSht2(x + k + j - 1, Sht2L + 3) = j + Rnd”用于初步处理前后同班问题。例如1、4、5、6、7、8、9、10班在第1考场均分配了6名考生，各班考生在座位号列都生成1.xxx、2.xxx、3.xxx、4.xxx、5.xxx、6.xxx样式的随机数，如下图1。再以考场号和座位号为关键字段进行排序后，初步实现前后无同班，如下图2。

巧用Excel <wbr>VBA <wbr>快速编排考场座位

图1

巧用Excel <wbr>VBA <wbr>快速编排考场座位

图2
程序再按蛇形排列座位的方法检查各座位前后左右是否有同班，如果遇有同班，程序通过循环将该考生与同考场其他考生调换座位，直到符合前后左右无同班后退出循环。
代码：
k = 2 '第一行为标题列，考生从第二行开始
Do While k <= UBound(ArrSht2, 1)
'座次按考场写入数组********
For x = 2 To UBound(ArrKC, 1) '考场号循环
If ArrSht2(k, Sht2L + 2) = ArrKC(x, 2) Then '找到考场
Exit For
End If
Next x
i = 0
For y = 3 To UBound(ArrKC, 2) - 1 '组循环
If Val(ArrKC(x, y)) > 0 Then '该组分配了人数
i = i + 1 '组数累加
For j = 1 To Val(ArrKC(x, y)) '该组人数
If i Mod 2 <> 0 Then ' 奇数组
RenShuFenPei(j, 2 * i - 1) = ArrSht2(k + j - 1, Sht2BJL) '班级
RenShuFenPei(j, 2 * i) = k + j - 1 '行号
Else ' 偶数组
RenShuFenPei(j, 2 * i - 1) = ArrSht2(k + Val(ArrKC(x, y)) - j, Sht2BJL) '班级
RenShuFenPei(j, 2 * i) = k + Val(ArrKC(x, y)) - j '行号
End If
Next j
k = k + Val(ArrKC(x, y)) '已编排的总人数(年级)+1
End If
Next y
'*************************
'处理前后左右同班***********
For m = 1 To MaxRen
For y = 1 To UBound(RenShuFenPei, 2) Step 2
If Len(RenShuFenPei(m, y)) > 0 And Len(RenShuFenPei(m, yR)) > 0 Then
If RenShuFenPei(m, y) = RenShuFenPei(m, yR) Or RenShuFenPei(m, y) = RenShuFenPei(mD, y) Then '左右或前后同班
For y1 = 1 To UBound(RenShuFenPei, 2) Step 2
Select Case RenShuFenPei(m1, y1)
Case ''
Case RenShuFenPei(m, y)
Case RenShuFenPei(mU, y)
Case RenShuFenPei(mD, y)
Case RenShuFenPei(m, yL)
Case RenShuFenPei(m, yR)
Case Else
Select Case RenShuFenPei(m, y)
Case RenShuFenPei(m1U, y1)
Case RenShuFenPei(m1D, y1)
Case RenShuFenPei(m1, y1R)
Case RenShuFenPei(m1, y1L)
Case Else
'改动座次表&&&&&&&&&
StrY = RenShuFenPei(m, y)
RenShuFenPei(m, y) = RenShuFenPei(m1, y1)
RenShuFenPei(m1, y1) = StrY
'&&&&&&&&&&&&&&&&&&
'改动考场编排表&&&&&&&&&&
For j = 1 To Sht2L
Temp1(0, j) = ArrSht2(RenShuFenPei(m, y + 1), j)
Next j
For j = 1 To Sht2L
ArrSht2(RenShuFenPei(m, y + 1), j) = ArrSht2(RenShuFenPei(m1, y1 + 1), j)
Next j
For j = 1 To Sht2L
ArrSht2(RenShuFenPei(m1, y1 + 1), j) = Temp1(0, j)
Next j
'&&&&&&&&&&&&
End Select
End Select
Next y
Next m
'***************
Loop
运行结果如图3所示：

巧用Excel <wbr>VBA <wbr>快速编排考场座位

图3
最后对各考生编上座位号，考场编排完成。
二、座位表、桌贴的生成与打印
考生座位表、桌贴等的制作总体上讲是对单元格填充的过程，因此代码比较简单。但由于存在各考场人数不同、组数不同及各组人数不同的情况，在算法上，需利用考场组数及各组人数，采用循环语句进行填充。代码详见上面的前后左右同班处理，运行结果如图3、图4所示。

巧用Excel <wbr>VBA <wbr>快速编排考场座位

图4
座位表及桌贴生成完毕后，由于是每个考场一张表，需要将这些表作为一个组才能一次性打印，而且可以选择打印部分考场，否则操作比较麻烦，有违简洁高效的目的，因此，在打印和预览上，在界面用两个ListBox列表框提供选择需打印的工作簿及相应的工作表，程序智能根据不同的表格设置页面，当然也可以在界面更改页面设置，以适应打印输出。然后根据界面上的数据设置工作表页面，再对这些表利用数组一次性选择输出打印和预览。
打印界面如图5所示。

巧用Excel <wbr>VBA <wbr>快速编排考场座位

图5
代码：
For i = 0 To Me.ListBox2.ListCount - 1
If Me.ListBox2.Selected(i) = True Then
ReDim Preserve ArrSht(k)
ArrSht(k) = .Name '需打印工作表读入数组
k = k + 1
End If
Next
Worksheets(ArrSht).PrintOut '利用数组一次性输出打印
桌贴打印时可能出现某考生信息横跨2页的情况，程序先获取打印工作表当前状态下每页的行数，整除每考生桌贴占用的行数（本例占用5行），得到每页不横跨2页每组的考生数，再乘以每考生桌贴占用的行数，即可得到每页的行数，通过循环语句手工重新指定分页符，使其符合打印要求。
代码：
ActiveWindow.View = xlPageBreakPreview '进入分页预览状态
.ResetAllPageBreaks '重设分页符（删除人工分页符），让工作表自动产生分页符
ShtFSTrows = ((Application.ExecuteExcel4Macro('INDEX(GET.DOCUMENT(64),1)') - TitleRows) \ 5) * 5 '每页行数=(自动分页时每页行数 \ 5 ) * 5
For m = 1 To CInt((.UsedRange.Rows.Count - TitleRows) / ShtFSTrows + 0.5) '总页数（向上取整）
.HPageBreaks.Add Before:=Cells(m * ShtFSTrows + .UsedRange.Row + TitleRows, 1) '手工指定分页符
Next m
ActiveWindow.View = xlNormalView '还原为常规视图
到此，VBA编写的考场编排程序初步完成，加上稍许美化和容错处理，如图6所示，一个高效简洁的考场编排程序就完成了。

巧用Excel <wbr>VBA <wbr>快速编排考场座位

图6
参考文献：
钱建明，EXCEL VBA 在考场编排中的设计与实现文章编号：1673-8454（2014）14-0065-05 《中国教育信息化》
罗刚君，EXCEL 2010 VBA编程与实践北京：电子工业出版社，2010.12

举报/Report

我的更多文章

下载客户端阅读体验更佳