【利用Excel,VBA制作多选题考试系统】 Excel多选题统计

　　面对大量的选择题考试，如果印刷纸质试卷，考完后由教师人工阅卷，不但效率低下，而且浪费人力、物力，还很容易出错。即使学校有条件使用机读卡考试，也会提高成本，浪费财力。我们利用Excel VBA制作了选择题考试系统，使用方便，节约人力、物力，深受广大教师的欢迎。下面我以多选题为例介绍一下具体做法，供读者参考。
　　一、界面设计
　　启动Excel2003，把Sheet1更名为“多选题”，Sheet2更名为“多选题库”，在“多选题”中输入相应的内容，把窗口右上角的“垂直拆分块”拖动到第五行的下边缘，再点击“窗口→冻结窗格”。两个按钮以后再添加，如图1所示。
　　图1
　　把题目录入到“多选题库”中，其中第一行为字段名，在A1―H1中分别输入：章、题号、答案、题干、A、B、C、D。第二行以下为题目，如图2所示。录入完毕后统计一下题目总数(我这里共录入了303道题，考试抽取20道题，考试时间共30分钟)，在“多选题”的下列单元格中分别输入内容（O1：总题数、P1：303、O2：抽题数、P2：20、Q1：考试时间(分钟)、Q2：30）。选择“工具→保护→允许用户编辑区域”，把B2、D2、H5放入其中。至此，准备工作基本完毕。
　　图2
　　二、代码编辑
　　限于篇幅，以下只介绍代码编辑中的技术性问题，详细请参阅省略/413660998?ptlang=2052。按Alt+F11键，进入VBA编辑界面，按Ctrl+R显示“工程资源管理器”窗口，按F4显示“属性”窗口。
　　1.启动代码简介
　　双击“Microsoft Excel中对象”中的“ThisWorkbook”，在右侧窗口中输入代码。这部分代码触发Workbook_Open()事件，主要有三项任务。其一是利用“Worksheets("多选题库").Visible = xlSheetHidden”隐藏题库；其二是清除上一名考生保存的信息；其三是利用MsgBox语句给出“考试说明和答题注意事项”。
　　2.随机出题代码简介
　　插入模块，将其命名为“随机出题”（Sub SetAPaper()），在其中输入代码。任务有两项。其一是根据“总题数”和“抽题数”产生相应的不重复随机数，并存入“Tihao()”数组，示例代码如下：
　　For i = 1 To tishu
　　B: Randomize
　　 y = Int((StartEnd(1, 2) - StartEnd(1, 1) + 1) * Rnd() + StartEnd(1, 1))
　　 For j = 1 To i
　　 If Tihao(1, j) = y Then
　　 GoTo B: End If
　　 Next j: Tihao(1, i) = y:Next i
　　StartEnd(1,1)=1表示起始题号，StartEnd(1,2)=总题数，是结束题号，Tishu=抽题数。Randomize语句的作用是初始化随机数生成器，避免每次启动程序时产生的随机数相同。其二是按照产生的随机数抽取题目，写在试卷的相应位置上。示例代码如下，其中Dxt代表“单选题”工作表，Dxtk代表“单选题库”工作表。
　　n = 1:i = 1
　　For i = 1 To tishu
　　Cells(i * 5 + 1, 2) = CStr(i) & "."题号
　　Cells(i * 5 + 1, 3) = Dxtk.Cells(Tihao(1, i) + 1, 4) ""题干
　　Cells(i * 5 + 2, 2) = "A.": Cells(i * 5 + 3, 2) = "B."
　　Cells(i * 5 + 4, 2) = "C.": Cells(i * 5 + 5, 2) = "D."
　　Cells(i * 5 + 2, 3) = Dxtk.Cells(Tihao(1, i) + 1, 5) ""A选项
　　Cells(i * 5 + 3, 3) = Dxtk.Cells(Tihao(1, i) + 1, 6) ""B选项
　　Cells(i * 5 + 4, 3) = Dxtk.Cells(Tihao(1, i) + 1, 7) ""C选项
　　Cells(i * 5 + 5, 3) = Dxtk.Cells(Tihao(1, i) + 1, 8) ""D选项
　　Dxtk.Cells(i + 1, 10) = Dxtk.Cells(Tihao(1, i) + 1, 3) ""记录答案
　　Next i
　　3.按钮和学生答题代码
　　双击“Microsoft Excel 对象”中的“Sheet1(多选题)”，在右侧窗口中输入代码。其中两个按钮代码一个是“随机出题”：Call SetAPaper；一个是“交卷评分”：Call Score。学生答题主要是触发Worksheet_SelectionChange(ByVal Target As Range)事件，用r=Target.Row记录单击的行号，用x=Int((r-1)/5)记录题号。如果单击的不是第二列就退出，是题号行也退出。如果单击的是“选项”，就记录其值，并判断答案中是否已经存在该选项。如果存在就删除，如果不存在就添加。示例代码如下：
　　With Worksheets("多选题")
　　 danji = Left(Target.Value, 1)
　　 If Cells(x * 5 + 1, 1) = "" Then
　　 Cells(x * 5 + 1, 1) = danji
　　 Else
　　mylen = Len(Cells(x * 5 + 1, 1)): For m = 1 To mylen
　　If danji = Mid(Cells(x * 5 + 1, 1), m, 1) Then """如果存在
　　 Cells(x * 5 + 1, 1) = Replace(Cells(x * 5 + 1, 1), danji, "") """就删除
　　Exit Sub: End If: Next m
　　 Cells(x * 5 + 1, 1) = Cells(x * 5 + 1, 1) & danji """不存在就添加
　　 End If
　　End With
　　显示控件工具箱工具栏，添加第一个按钮并双击之，在属性窗口中把其Caption属性更改为“随机出题”，添加第二个按钮，把其Caption属性更改为“交卷评分”。
　　4.计时器代码
　　插入模块，命名为“计时器”，在其中输入代码，其中RemT=Worksheets("多选题").Cells(2, 17)1，Sec=60，Jg=1。通过runtimer()过程和js()过程的循环调用，利用OnTime函数，在屏幕上显示变化的时间，并实现剩余1分钟提醒，到时自动交卷。
　　Sub runtimer() "时间运行
　　Application.OnTime Now + TimeValue("00:00:" & Jg), "js"
　　End Sub
本文为全文原貌 未安装PDF浏览器用户请先下载安装 原版全文 　　Sub js() "计时
　　If CStr(Cells(1, 12)) <> "" Then Exit Sub
　　If Sec > 0 Then
　　Sec = Sec - Jg:Worksheets("多选题").Cells(5, 8) = "考试剩余时间：" & RemT & ":" & Sec
　　Else: Sec = 60
　　If RemT > 0 Then
　　If RemT = 1 Then MsgBox "离考试结束还有1分钟！": ThisWorkbook.Save: RemT = RemT - 1
　　Else:MsgBox "考试结束！":Call Score:End If: End If: Call runtimer
　　End Sub
　　5.自动评分代码
　　插入模块，命名为“自动评分”（Sub Score()），在其中输入代码。
　　Sub Score() "自动评分
　　ts = Cells(2, 16): n = ts * 5 + 5: DF = 0
　　For m = 6 To n Step 5
　　If Cells(m, 1) <> "" Then
　　mylen = Len(Cells(m, 1))
　　BzDaan = Worksheets("多选题库").Cells(1 + (m - 1) / 5, 10)
　　For i = 1 To mylen
　　MyCheck = Mid(Cells(m, 1), i, 1) Like "[" & BzDaan & "]"
　　If MyCheck = False Then GoTo C
　　Next i
　　If Len(Cells(m, 1)) = Len(BzDaan) Then DF = DF + 1
　　If Len(Cells(m, 1)) 本文为全文原貌 未安装PDF浏览器用户请先下载安装 原版全文