生成身体素质测试成绩登记表

1、Excel VBA生成身体素质测试成绩登记表陈奇军 浦江县仙华外国语学校 邮编：322200摘 要体育中考时学校会按照要求对考生进行级分组，然后按照分组顺序制作体育中考身体素质成绩登记表，用于记录学生成绩。根据要求，成绩登记表有统一的格式，表中的数据前后顺序有相关性，并且要准备好数据一一对应的Excel工作簿，用于考试成绩批量录入。如果纯粹使用手工制作的话工作量会较繁重，且容易出错。笔者简要分析了考生数据分组的规律性，利用Excel VBA技术设计了一个宏程序，实现了对考生进行自动分组，还实现了用模板自动生成有统一规格的成绩登记表。关键词体育中考 分组 数据处理 自动生成 Excel VBA一

2、、分组规律用于批量录入成绩的Excel工作表一般包含班级、姓名、报名序号、体育代码(也叫类别代码)等数据，如下表(1)所示。班级姓名报名序号性别身份证号体育代码901张*0441男XXXXXX19960311XXXX12133905陈*0526男XXXXXX19960523XXXX12232903毛*0273男XXXXXX19960416XXXX12131904季*0535男XXXXXX19960910XXXX12434表(1)表(1)还不能直接用来录入成绩，需要加工。按照考试要求，考生数据要先按照体育代码排好，然后把体育代码相同的分为一个组，每组12名考生；超过12名则另分一组，不足12名的

3、即使只有1名考生也分为一组；组号为三位数。分组如下表(2)所示。班级姓名报名序号性别身份证号体育代码组号组内编号904张*0272男XXXXXX19950321XXXX121310011905张*0256男XXXXXX19960507XXXX121310012907金*0273男XXXXXX19960413XXXX121310013901季*0421男XXXXXX19960113XXXX121330021902彭*0176男XXXXXX19960406XXXX121340031902张*0233男XXXXXX19960920XXXX121340032表(2)二、体育代码解释体育代码也叫类别代码

4、。考生共要参加三个项目的考试，根据项目性质分成三类。一类是必考项目，男子考1000米跑，女子考800米跑；二类是球类项目，三类是非球类项目。用一个五位数很容易代表考生所选的内容。五位数的第1位是性别代码，1为男，2为女；第2-3位为第二类测试项目，如21为篮球；后2位为第三类测试项目，如31为跳远。有关的项目名称后面的代码清单中有介绍。三、成绩登记表分析成绩登记表如下表(3)所示，页面为横向A4格式，表格中间略有改动。表中类别、报名序号、姓名、项目名称、项目代码、组别等项目是动态变化的，其他内容和格式则固定不变很容易让人想到使用模板的方法来生成这种表格。另外从表(3)中我们可以看出，根据这样的

5、成绩登记表，表(2)已可以用来录入成绩了。*县2011体育中考身体素质测试成绩登记表（一类二类三类）考点：*考点 单位：*学校项目名称：乒乓球 项目代码：25 女子第 006 组序号报名序号姓名测试得分补考得分成绩成绩1231231*0013王*2*0014方*3*0015郑*中间略去11*0023钟*12*0024蒋*考评员：_监察员：_记录员：_学生代表：_ 年 月 日表(3)四、编程思路对于分组，可设置两个变量，一个用于存放当前行的体育代码，一个用于存放下一行的体育代码，在表(2)所示的工作表中从上到下循环读取体育代码，每读一次比较一次，不同时则递增组号，读取次数达到12时则相应递增组号

6、。对于成绩登记表，有几个组就需要几张成绩登记表。根据前面的想法，只要在分组时复制出模板，然后在程序中对复制出的模板进行动态的数据填充就可以完成各组成绩登记表的制作。由于具有相关性，两个操作可以合并到一个程序中完成。当然数据工作表和成绩登记表模板以及程序要放在同一个工作簿中。由于采用相同的分组办法，对于不同类别的成绩登记表也可以采用相同的程序，只要对源程序稍微修改一下就可以适用于不同类别成绩登记表的制作。限于篇幅笔者这里仅提供类别二的程序清单，并作了解释，稍微改一下就能通用于其他两个类别。清单如下：Const GCount = 12 '12个人一组Const sTitle1 = &quo

7、t;*县2011体育中考身体素质测试成绩登记表" & _ "（一类二类三类）"Const sTitle2 = "*县2011体育中考身体素质测试成绩登记表" & _ "（一类二类三类）"Const sTitle3 = "*县2011体育中考身体素质测试成绩登记表" & _ "（一类二类三类）"Sub 自动分组二类() '运行本程序前先按体育类别代码排序'功能：1.根据排好的类别代码自动填写组号和组内序号 '2.填写二类名称、二类代码Dim

8、 sDataBase, sDBGS '用于引用数据库Dim sModel, tModel '用于引用模板Dim sSheetName '用于动态指定工作表名Dim p, gNumber, nNumber 'p数据库指针，gNumber组号，nNumber组内序号Dim sGNumber '用于填写指定的三位数组号Dim ID, sStudentName '学生报名序号、姓名Dim ProjCode, ProjCodeTemp 'ProjCode类别代码 'ProjCodeTemp用于保存临时类别代码Dim sSex '性别

9、Dim sNameC2, sCodeC2 '二类名称、二类代码Dim sNameC3, sCodeC3 '三类名称、三类代码'初始化p = 2gNumber = 1Set sDataBase = Sheets("数据库") 引用表(2)数据Set sDBGS = Sheets("组名与类别") 用于统计Set sModel = Sheets("模板") 成绩登记表模板ProjCode = sDataBase.Cells(p, 6) '当前p行类别代码sSex = Mid(ProjCode, 1, 1)

10、'取性别If sSex = 1 Then sSex = "男"Else sSex = "女"End IfProjCodeTemp = sDataBase.Cells(p, 6) '保存临时类别代码'取二类名称、二类代码sCodeC2 = Mid(ProjCode, 2, 2)sNameC2 = sCode2sName2(sCodeC2)If Len(sNameC2) < 1 Then MsgBox "在分析二类类别代码时发现错误，请检查数据或格式是否正确" & _ vbNewLine &

11、"当前执行报名序号:" & ID GoTo endopEnd If'先复制一个模板sModel.Copy After:=Sheets(Sheets.Count)sSheetName = "第" & gNumber & "组" & ProjItemSheets("模板 (2)").Name = sSheetNameSet tModel = Sheets(sSheetName)'初始化表格数据tModel.Cells(1, 1) = sTitle2tModel.Cells

12、(2, 5) = "项目名称： " & sNameC2 & _ " 项目代码： " & sCodeC2 & _ " " & sSex & "子 第 " & GetsGNumber(gNumber) & " 组"'主循环Do For nNumber = 1 To GCount 'GCount为每组学生数 '更新临时变量 ProjCodeTemp = sDataBase.Cells(p, 6) '保存临时

13、类别代码 '判断类别代码是否发生变化如果变化则退出For循环 If ProjCodeTemp <> ProjCode Then Exit For Else '否则填写数据 ID = sDataBase.Cells(p, 3) '报名序号 sStudentName = sDataBase.Cells(p, 2) '取学生姓名 '组号和组内序号 sDataBase.Cells(p, 7) = GetsGNumber(gNumber) '三位数组号 sDataBase.Cells(p, 8) = nNumber '组内序号 tMod

14、el.Cells(5 + nNumber, 2) = ID tModel.Cells(5 + nNumber, 3) = sStudentName End If '偏移指针 p = p + 1 '判断数据是否已经读完，读完数据则结束程序，否则进行下一步处理 If sDataBase.Cells(p, 2) = "" Then GoTo endop End If Next nNumber '偏移组号 gNumber = gNumber + 1 '更新项目变量和临时项目变量 ProjCode = sDataBase.Cells(p, 6) 

15、9;类别代码 ProjCodeTemp = sDataBase.Cells(p, 6) '保存临时类别代码 sSex = Mid(ProjCode, 1, 1) '取性别 If sSex = 1 Then sSex = "男" Else sSex = "女" End If '取二类名称、二类代码 sCodeC2 = Mid(ProjCode, 2, 2) sNameC2 = sCode2sName2(sCodeC2) If Len(sNameC2) < 1 Then MsgBox "在分析二类类别代码时发现错误，请

16、检查数据或格式是否正确" & _ vbNewLine & "当前执行报名序号:" & ID GoTo endop End If '取三类名称、三类代码 'sCodeC3 = Mid(ProjCode, 4, 2) '复制模板 sModel.Copy After:=Sheets(Sheets.Count) sSheetName = "第" & gNumber & "组" & ProjItem Sheets("模板 (2)").Name

17、= sSheetName Set tModel = Sheets(sSheetName) '初始化表格数据 tModel.Cells(1, 1) = sTitle2 tModel.Cells(2, 5) = "项目名称： " & sNameC2 & _ " 项目代码： " & sCodeC2 & _ " " & sSex & "子 第 " & GetsGNumber(gNumber) & " 组"Loop Until sDa

18、taBase.Cells(p, 2) = "" '当报名序号为空时退出'结束处理MsgBox "二类登记表造册完毕"endop:Set sDataBase = NothingSet sModel = NothingSet tModel = NothingSet sDBGS = NothingEnd Sub '自动分组二类'二类代码转二类名称Function sCode2sName2(sCodeC2)Select Case sCodeC2Case 21 sCode2sName2 = "篮球"Case 22

19、 sCode2sName2 = "排球"Case 23 sCode2sName2 = "足球"Case 24 sCode2sName2 = "羽毛球"Case 25 sCode2sName2 = "乒乓球"Case 26 sCode2sName2 = "毽球"Case Else sCode2sName2 = ""End SelectEnd Function'三类代码转三类名称Function sCode2sName3(sCodeC3)Select Case sCodeC3Case 31 sCode2sName3 = "跳远"Case 32 sCode2sName3 = "50米"Case 33 sCode2sName3 = "实心球"Case 34 sCode2sName3 = "跳绳"Case 35 sCode2sName3 = "引体向上"Case 36 sCode2sName3 = "仰卧起坐"Case Else sCode2sName3 = &qu