如何按成绩和性别分班

hlly888

jxndwxs 发表于 2014-7-24 17:14
如果在“报名信息”表中改变了字段（增加或减少），在“基数统计”使用中，有些功能会出错。

每个人设计的表格都不尽相同，无法写出万能的代码。如果原表增减列，代码必会出错。
如果想增加或减少某列，自己需懂点VBA才好。
同班重名的问题，再大的学校重名现象出现的不会太多，可 人工调整。本来速度就不够快，再循环多次只会增加运行时间。
健康状况，如果表中有实际数据也可以统计。
如果有实际数据任何项目均可以统计。

jxndwxs

aoe1981 发表于 2014-7-24 19:54
你提的一个“择班”问题，一个“重姓名”问题，都是重磅的呀……看来这个工作应当分步骤完成，指着一次性 ...

也是的，任何一个程序不可能十全十美。你和hlly888老师都很尽力的完善程序了，而且都设计的很好。谢谢你们了。

jxndwxs

hlly888 发表于 2014-7-24 20:00
每个人设计的表格都不尽相同，无法写出万能的代码。如果原表增减列，代码必会出错。
如果想增加或减少某 ...

是呀，我不懂VBA，只是自己想怎么样，就要求老师做到怎么样。实在对不起。请老师原谅。

香川群子

分班条件:
1、先男生后女生分开，然后按总分从高到低排序后依名次顺序分班。力争各班成绩搭配均匀。
2、假如分5个班，名次要按：12345,23451,34512,45123,51234 错位分配。

1. Sub kagawa()
   
2. 
   
3.     tms = Timer '开始计时
   
4.     k = Sheets("分班").Range("g1") '获取分班数k
   
5. 
   
6.     Sheets("报名信息").Activate
   
7.     m = [a65536].End(3).Row - 2 '数据表有效行数m
   
8.     n = 17  '数据表有效列数n=17 (到Q列)
   
9.     Range("a3").Resize(m, n).Sort [c3], 1, [p3], , 2, , , 2 '按男女、总分 进行工作表倒序排序
   
10.     arr = Range("a3").Resize(m, n) '工作表排序后的数据读入数组arr
    
11.         
    
12.     ReDim brr(k - 1) '按班级数定义嵌套数组
    
13.     ReDim crr(-1 To m \ k, 1 To n) '记录每个班信息的嵌套子数组
    
14.     For j = 1 To n
    
15.         crr(-1, j) = Cells(2, j) '写入班级信息标题栏
    
16.     Next
    
17.     For i = 0 To k - 1
    
18.         brr(i) = crr '嵌套数组初始化
    
19.     Next
    
20.         
    
21.     ReDim crr(m - 1, 0) '记录实际分班序号
    
22.     ReDim drr(9, 2)       '按要求统计各班男女生人数、总分合计
    
23.     For t = 0 To m - 1 '按排序后的顺序 遍历原始数据各行
    
24.         c = (t + t \ k) Mod k '计算当前班级 【注意：可按楼主要求自动进行班级顺序错位】
    
25.                                      '即 12345 23451 34512 45123 51234 12345 ……这样的错位进行
    
26.         crr(t, 0) = c + 1
    
27.         i = t \ k  '计算当前班级所在行序号i
    
28.         brr(c)(i, 1) = c + 1 '第1列写入分配班级
    
29.         For j = 1 To n '第2-18列 照搬原始数据
    
30.             If j = 5 Or j = 10 Then brr(c)(i, j) = "'" & arr(t + 1, j) Else brr(c)(i, j) = arr(t + 1, j)
    
31.         Next
    
32.         
    
33.         If arr(t + 1, 3) = "男" Then drr(c, 0) = drr(c, 0) + 1 Else drr(c, 1) = drr(c, 1) + 1
    
34.         drr(c, 2) = drr(c, 2) + arr(t + 1, 16)
    
35.     Next
    
36.     MsgBox Format(Timer - tms, "0.000s") '172个学生分成5个班计算耗时约 0.03-0.04秒
    
37.     Range("a3").Offset(, n).Resize(m) = crr '在报名信息表最后一列输出现在的分班班序
    
38.    
    
39.     Sheets("分班").Range("c2:e11") = drr '分班后统计结果输出
    
40. '    Stop
    
41. 
    
42.     '删去以前的工作表
    
43.     Application.DisplayAlerts = False
    
44.     For i = Sheets.Count To 3 Step -1
    
45.         Sheets(i).Delete
    
46.     Next
    
47.    
    
48.     '下面是新建工作表并逐个输出各班级结果
    
49.     For i = 0 To k - 1
    
50.         Sheets.Add After:=Sheets(Sheets.Count)
    
51.         Sheets(Sheets.Count).Name = "班" & Right(0 & i + 1, 2)
    
52.         Sheets(Sheets.Count).Range("a1").Resize(m \ k + 2, n) = brr(i)
    
53.     Next
    
54.     Sheets("分班").Activate
    
55. End Sub
    

复制代码

香川群子

aoe1981 发表于 2014-7-24 19:59
这个的确是的，您是数组、组合……的鼻祖！

发现我的代码计算耗时，还包括了重新排序的时间。

如果不算排序时间(事先已经排序完成)，那么我的代码耗时更少……大约0.01秒以下。


因为我的班级计算只要一句代码：c = (t + t \ k) Mod k

你的复杂多了。

aoe1981

香川群子 发表于 2014-7-24 22:05
发现我的代码计算耗时，还包括了重新排序的时间。

如果不算排序时间(事先已经排序完成)，那么我的代码 ...

我这会正在研究，发现三个优点：
1.按性别＋总分事先进行排序，省去了大量循环内部的性别条件判断，也进一步简化了代码，提升了速度；
2.标题行的写入优化了，我的还是逐工作表、逐单元格的写入方式，以为少了，便没动心思；
3.这一句：c = (t + t \ k) Mod k极端精彩！

aoe1981

香川群子 发表于 2014-7-24 22:05
发现我的代码计算耗时，还包括了重新排序的时间。

如果不算排序时间(事先已经排序完成)，那么我的代码 ...

下面我再与我的整体代码参考、借用、磨合下！

夏秋梦

aoe1981 发表于 2014-7-24 19:49
什么叫“同姓名的人分在同一班”？附件中是模拟数据，基本的有170人，为了测试代码的效率，复制粘贴了若干 ...

谢谢aoe1981大侠的回答，我做教务大约有10年时间，分班更不止10年，分班的好坏对班主任和授课教师，甚至整个学校都有影响，同姓名在班里面做事比较麻烦，小事情。我还想到的是，择班生楼主提的很好，（我不知道楼主的择班生是什么原因，但我大致上心中有数），目前我还想到的还有另外的一些原因：1、家庭特别困难的学生（包括孤儿），2、性格较差，特别难管的，3、弱智的，这些学生都不能分在一个班，不管他们的成绩，最好分散他们，便于照顾和管理。当然这些学生情况先摸清楚，这些学生不能先拿出来分班，作为特殊的一块均匀分班，同时也要考虑他们的成绩。以前我校一个年级有5个孤儿，都分在一个班，事后才知道，大家看这个班主任要带好学生，与其他班主任比较……，难管的学生在一个班，他们就成了团体……，弱智的和困难学生一样需要照顾……，一般分下去了，有的一带就是三年……

夏秋梦

你们研究的这个分班程序，我可能用得着，谢谢你们！

夏秋梦

我已经收藏，会关注你们，我用Excel 做事，大部分是用函数公式来的，目前正在做一个表，一个年级6200多人的成绩，用公式慢死了，准备学学vba