小学期末考试成绩册

liuxi001 · 发表于 2019-1-5 23:35

本帖最后由 liuxi001 于 2019-1-8 08:33 编辑

最近修修改改，总算是告一段落，基本满足我的需要了。
美中不足：
领导要求班级间学生打乱顺序考试，就是说每个考室的学生要求是多个班级的，例如一1班一个学生，接下一2班的，一3班的……
怎么穿插没有搞定，如果有多少班级就分成多少考室来排的话还好一点，如果一年级有五个班，平均人数超过50人，考试时每个考场不能坐这么多人，想采取手动设置考室数的办法，具体怎么实施一直没敢下手，还请前辈们指教。
考室座次的安排现在也不是太好，按照
      '分为3种班额编排座次,tmprow为考室人数
      If tmprow < 46 Then
         '5列
         列 = 5
      ElseIf tmprow < 55 Then
         '6列
         列 = 6
      Else
         '55人及以上
         列 = 7
      End If

但是话说回来，一般的考试多分出一些考室也是力所不能及，人手所限，监考难安排，两难！
还是想代码灵活一些，有方案可选最好不过

2018下成绩册(小学).zip (473.99 KB, 下载次数: 316)

补充内容 (2019-1-11 14:05):
四楼做了BUG修复，功能更新。

补充内容 (2019-1-25 07:24):
1.9版，可能是最终版了吧，想要的功能都有了，7楼更新代码。

补充内容 (2019-2-2 15:18):
10楼：2.02新

补充内容 (2019-2-14 19:11):
12楼，v2.04，就这样子吧

补充内容 (2019-3-9 02:13):
15楼更新了

补充内容 (2019-3-27 01:31):
17楼修复2处BUG

补充内容 (2019-4-24 20:42):
再一次修复。。。。。20楼。

补充内容 (2019-6-21 14:47):
最近更新置顶到2楼！

liuxi001 · 发表于 2021-12-3 10:29

支持自定义科目名和数量，主要为中学多科目而更新，可以计算3率，另增加筛选班/年级前n%统计功能。各表已自动设置好列宽行高适应A4，修复极端情况下的BUG。建议在office2010以上版本使用，2007精简版考务选项卡会有问题。

考务v20211203.zip (284.85 KB, 下载次数: 226)

vvw123 · 发表于 2019-1-6 07:47

很好的学习素材，下载收藏了。

liuxi001 · 发表于 2019-1-6 20:10

共同学习吧

liuxi001 · 发表于 2019-1-11 14:04

本帖最后由 liuxi001 于 2019-1-12 23:24 编辑

修复一些BUG，代码调整优化，把学校代码、考室号、考号改为文本数字！座次排序搞好了，但是考号的编排却是个麻烦，考室不好确定。

Sub 座次乱序()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim ar, i
Dim 班级列, 学校列, 姓名列, 总行, 总列
总列 = 11
Sheet1.[a1].Resize(1, 总列) = Array("总序号", "座次序号", "考号", "考室", "学校代码", "班级", "姓名", "语文", "数学", "英语", "总分")
For i = 1 To 总列
'获取班级、考室和考号的列号
If InStr(Sheet1.Cells(1, i), "班级") > 0 Then 班级列 = i
If InStr(Sheet1.Cells(1, i), "学校") > 0 Then 学校列 = i
If InStr(Sheet1.Cells(1, i), "姓名") > 0 Then 姓名列 = i
If InStr(Sheet1.Cells(1, i), "座次序号") > 0 Then 座次列 = i
Next
总行 = Sheet1.Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
If 总行 = 1 Then MsgBox "《在校生》表中没有数据，请录入学校代码、班级和姓名后再试！": Exit Sub
'获取总表数据
ar = Sheet1.Range(Sheet1.[a2], Sheet1.Cells(总行, 总列))
'判断是否已经乱序
'如已经乱序，则按年级和班级从小到大的顺序排列之后再试
Set 计数 = CreateObject("scripting.dictionary")
For i = LBound(ar) To UBound(ar)
s = ar(i, 学校列) & ar(i, 班级列)
计数(s) = 计数(s) + 1
ar(i, 座次列) = ar(i, 学校列) & Left(ar(i, 班级列), 1) & Format(计数(s), "00") & Right(ar(i, 班级列), 2)
Next
'____________________________________________________________________
'座次希尔排序
Dim 总大小, 间隔, x, y, v, tmp(1 To 30)
总大小 = UBound(ar) - LBound(ar) + 1
间隔 = 1
If 总大小 > 13 Then
Do While 间隔 < 总大小
间隔 = 间隔 * 3 + 1
Loop
间隔 = 间隔 \ 9
End If
Do While 间隔
For x = LBound(ar) + 间隔 To UBound(ar)
For v = 1 To 总列
tmp(v) = ar(x, v)
Next v
For y = x - 间隔 To LBound(ar) Step -间隔
'如果比tmp(座次列)小，则退出。按座次列排序
If ar(y, 座次列) <= tmp(座次列) Then Exit For
For v = 1 To 总列
ar(y + 间隔, v) = ar(y, v)
Next v
Next y
For v = 1 To 总列
ar(y + 间隔, v) = tmp(v)
Next v
Next x
间隔 = 间隔 \ 3
Loop
Sheet1.Range("a2").Resize(总行, 总列) = ar
End Sub

复制代码

dahuzhi · 发表于 2019-1-11 15:24

学习研究一下

liuxi001 · 发表于 2019-1-15 00:50

本帖最后由 liuxi001 于 2019-1-17 00:23 编辑

学生打乱顺序和还原顺序，编考号等，修复了一些问题。

liuxi001 · 发表于 2019-1-25 07:11

本帖最后由 liuxi001 于 2019-1-27 15:12 编辑

想要的功能都有了，只等修复未知BUG了。新增考生去向表，修改贴纸一页8人增加信息。

vvw123 · 发表于 2019-1-25 10:36

liuxi001 发表于 2019-1-25 07:11
想要的功能都有了，只等修复未知BUG了。

能否扩展成初中也可以用？

liuxi001 · 发表于 2019-1-25 10:59

vvw123 发表于 2019-1-25 10:36
能否扩展成初中也可以用？

这个刚刚写完，接下抽时间写

liuxi001 · 发表于 2019-2-2 15:17

本帖最后由 liuxi001 于 2019-2-5 11:04 编辑

增排序和排名

		自动登录	找回密码
密码			免费注册

[分享] 小学期末考试成绩册

评分

评分

评分

评分