小学期末考试成绩册

飛天白羽

最近修修改改，总算是告一段落，基本满足我的需要了。
美中不足：
领导要求班级间学生打乱顺序考试，就是说每个考室的学生要求是多个班级的，例如一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, 下载次数: 0)

2026-4-22 12:35 上传

点击文件名下载附件

补充内容 (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楼！

信杰廉悍

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

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

2026-4-22 12:35 上传

点击文件名下载附件

天堂里的死猪

后续更新几次一直没在论坛发，补发一下。 考务v20241107.rar (314.46 KB, 下载次数: 0)

2026-4-22 12:35 上传

点击文件名下载附件

彣炆

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

等娘娘烘焙

共同学习吧

笨爸说

修复一些BUG，代码调整优化，把学校代码、考室号、考号改为文本数字！座次排序搞好了，但是考号的编排却是个麻烦，考室不好确定。
<ol>Sub 座次乱序()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim ar, i
    Dim 班级列, 学校列, 姓名列, 总行, 总列
    总列 = 11
    Sheet1.[a1].Resize(1, 总列) = Array(&quot;总序号&quot;, &quot;座次序号&quot;, &quot;考号&quot;, &quot;考室&quot;, &quot;学校代码&quot;, &quot;班级&quot;, &quot;姓名&quot;, &quot;语文&quot;, &quot;数学&quot;, &quot;英语&quot;, &quot;总分&quot;)
    For i = 1 To 总列
        '获取班级、考室和考号的列号
        If InStr(Sheet1.Cells(1, i), &quot;班级&quot;) > 0 Then 班级列 = i
        If InStr(Sheet1.Cells(1, i), &quot;学校&quot;) > 0 Then 学校列 = i
        If InStr(Sheet1.Cells(1, i), &quot;姓名&quot;) > 0 Then 姓名列 = i
        If InStr(Sheet1.Cells(1, i), &quot;座次序号&quot;) > 0 Then 座次列 = i
    Next
    总行 = Sheet1.Cells.Find(&quot;*&quot;, , xlValues, xlPart, xlByRows, xlPrevious).Row
    If 总行 = 1 Then MsgBox &quot;《在校生》表中没有数据，请录入学校代码、班级和姓名后再试！&quot;: Exit Sub
    '获取总表数据
    ar = Sheet1.Range(Sheet1.[a2], Sheet1.Cells(总行, 总列))
    '判断是否已经乱序
    '如已经乱序，则按年级和班级从小到大的顺序排列之后再试
   
    Set 计数 = CreateObject(&quot;scripting.dictionary&quot;)
    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), &quot;00&quot;) & 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, 座次列)

林华帅

学习研究 一下

李鲁

学生打乱顺序和还原顺序，编考号等，修复了一些问题。 考试成绩册小学v1.8.zip (518.08 KB, 下载次数: 0)

2026-4-22 12:35 上传

点击文件名下载附件

雷霆之怒

想要的功能都有了，只等修复未知BUG了。新增考生去向表，修改贴纸一页8人增加信息。
考试成绩册小学v2.01.zip (669.93 KB, 下载次数: 0)

2026-4-22 12:35 上传

点击文件名下载附件

缺月

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