ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 Office知识技巧免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 2236|回复: 33

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

[复制链接]

TA的精华主题

TA的得分主题

发表于 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

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

1.png 2.png 3.png 4.png
2018下成绩册(小学).zip (473.99 KB, 下载次数: 140)

评分

参与人数 2财富 +10 鲜花 +2 收起 理由
vvw123 + 2 优秀作品
lsc900707 + 10 鼓励分享!

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-12-12 15:23 | 显示全部楼层
本帖最后由 liuxi001 于 2020-1-22 14:22 编辑

1.png

考试成绩册小学v2.21.zip (323.51 KB, 下载次数: 151)

TA的精华主题

TA的得分主题

发表于 2019-1-6 07:47 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-1-6 20:10 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-1-11 14:04 | 显示全部楼层
本帖最后由 liuxi001 于 2019-1-12 23:24 编辑

修复一些BUG,代码调整优化,把学校代码、考室号、考号改为文本数字!座次排序搞好了,但是考号的编排却是个麻烦,考室不好确定。
  1. Sub 座次乱序()
  2.     Application.ScreenUpdating = False
  3.     Application.DisplayAlerts = False
  4.     Dim ar, i
  5.     Dim 班级列, 学校列, 姓名列, 总行, 总列
  6.     总列 = 11
  7.     Sheet1.[a1].Resize(1, 总列) = Array("总序号", "座次序号", "考号", "考室", "学校代码", "班级", "姓名", "语文", "数学", "英语", "总分")
  8.     For i = 1 To 总列
  9.         '获取班级、考室和考号的列号
  10.         If InStr(Sheet1.Cells(1, i), "班级") > 0 Then 班级列 = i
  11.         If InStr(Sheet1.Cells(1, i), "学校") > 0 Then 学校列 = i
  12.         If InStr(Sheet1.Cells(1, i), "姓名") > 0 Then 姓名列 = i
  13.         If InStr(Sheet1.Cells(1, i), "座次序号") > 0 Then 座次列 = i
  14.     Next
  15.     总行 = Sheet1.Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
  16.     If 总行 = 1 Then MsgBox "《在校生》表中没有数据,请录入学校代码、班级和姓名后再试!": Exit Sub
  17.     '获取总表数据
  18.     ar = Sheet1.Range(Sheet1.[a2], Sheet1.Cells(总行, 总列))
  19.     '判断是否已经乱序
  20.     '如已经乱序,则按年级和班级从小到大的顺序排列之后再试
  21.    
  22.     Set 计数 = CreateObject("scripting.dictionary")
  23.     For i = LBound(ar) To UBound(ar)
  24.         s = ar(i, 学校列) & ar(i, 班级列)
  25.         计数(s) = 计数(s) + 1
  26.         ar(i, 座次列) = ar(i, 学校列) & Left(ar(i, 班级列), 1) & Format(计数(s), "00") & Right(ar(i, 班级列), 2)
  27.     Next
  28.     '____________________________________________________________________
  29.     '座次希尔排序
  30.     Dim 总大小, 间隔, x, y, v, tmp(1 To 30)
  31.     总大小 = UBound(ar) - LBound(ar) + 1
  32.     间隔 = 1
  33.     If 总大小 > 13 Then
  34.         Do While 间隔 < 总大小
  35.             间隔 = 间隔 * 3 + 1
  36.         Loop
  37.         间隔 = 间隔 \ 9
  38.     End If
  39.     Do While 间隔
  40.         For x = LBound(ar) + 间隔 To UBound(ar)
  41.             For v = 1 To 总列
  42.                 tmp(v) = ar(x, v)
  43.             Next v
  44.             For y = x - 间隔 To LBound(ar) Step -间隔
  45.             '如果比tmp(座次列)小,则退出。按座次列排序
  46.                 If ar(y, 座次列) <= tmp(座次列) Then Exit For
  47.                 For v = 1 To 总列
  48.                     ar(y + 间隔, v) = ar(y, v)
  49.                 Next v
  50.             Next y
  51.             For v = 1 To 总列
  52.                 ar(y + 间隔, v) = tmp(v)
  53.             Next v
  54.         Next x
  55.         间隔 = 间隔 \ 3
  56.     Loop
  57.     Sheet1.Range("a2").Resize(总行, 总列) = ar
  58. End Sub
复制代码


考试成绩册V1.4 pwd9112689.rar

598.92 KB, 下载次数: 41

TA的精华主题

TA的得分主题

发表于 2019-1-11 15:24 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-1-15 00:50 | 显示全部楼层
本帖最后由 liuxi001 于 2019-1-17 00:23 编辑

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

考试成绩册小学v1.8.zip

518.08 KB, 下载次数: 25

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-1-25 07:11 | 显示全部楼层
本帖最后由 liuxi001 于 2019-1-27 15:12 编辑

想要的功能都有了,只等修复未知BUG了。新增考生去向表,修改贴纸一页8人增加信息。
1.jpg
2.jpg
3.jpg
4.jpg
5.jpg

考试成绩册小学v2.01.zip

669.93 KB, 下载次数: 53

评分

参与人数 1鲜花 +2 收起 理由
vvw123 + 2 优秀作品

查看全部评分

TA的精华主题

TA的得分主题

发表于 2019-1-25 10:36 | 显示全部楼层
liuxi001 发表于 2019-1-25 07:11
想要的功能都有了,只等修复未知BUG了。

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

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-1-25 10:59 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-2 15:17 | 显示全部楼层
本帖最后由 liuxi001 于 2019-2-5 11:04 编辑

增排序和排名

考试成绩册小学v2.02.rar

697.35 KB, 下载次数: 48

评分

参与人数 1鲜花 +2 收起 理由
vvw123 + 2 优秀作品

查看全部评分

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,每天学会一个新技能

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2020-4-5 14:08 , Processed in 0.104932 second(s), 23 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表