如何按成绩和性别分班

liyunfei099

夏秋梦 发表于 2014-7-24 22:33
我已经收藏，会关注你们，我用Excel 做事，大部分是用函数公式来的，目前正在做一个表，一个年级6200多人的 ...

我的天，一个年级6200人，有好多个班？

夏秋梦

liyunfei099 发表于 2014-7-25 12:11
我的天，一个年级6200人，有好多个班？

没说假话，不是我们学校的，实实在在这个年级有6254人，是全县的一个年级，一共126个班级，你说我这个分析表该多大，都用函数，运行太慢，哪天有空，请教这些高手，试试用vba做一下。

夏秋梦

说点看法，谈点感想，大家不要见笑（主要是看到你们讨论的也是我多年来所想的），能开发这么好的程序来，为广大教育工作者节约了很多时间、少动好多脑筋，真的谢谢您们：
根据我多年分班经历，和从班主任反映的情况来看，提点建议：你们研究这个程序我认为执行速度是次要的，实用是主要的，一个学校分班不是一下子完成的，考虑的东西多。我认为要优化的是，一个是分步完成分班，第二个是在表中增加分步按钮，第四个是将特殊学生单独提取出来（用一个标志在“报名信息表“标明，分班好后，tm单独存放在一个表中，一目了然）：1、在“报名信息表“中，不要手工操作，单独制作两个按钮，一个是按你们设置排序方法排序按钮，另一个是撤销排序按钮，当排序好后，再执行分班。2、在分班信息中：（1）增加个一键清除按钮，当执行程序分班后，如果效果不好，撤销操作。（2）、分班后的信息要详细（因为大家都不认识和了解新生）、班主任要了解的是总平均分、各科平均分、男女人数、有多少难管的等特殊学生等信息，还有就是那些排名最前的学生自己分了多少个，第一名谁抽到了。
我从1999年分班到现在，改了很多的方法，有时候分班烦躁，干脆把学生交给班主任他们自己分也做过。分班的一个目的是追求公平，各个班在同一起跑线上赛跑（这个公平就是同一起跑线）。至于以后的赛跑成绩就看他们的本事了。
题外话：一般情况新生都是在假期分好班的，不管你怎么分均匀，但开学报名，新生稳定下来，再统计他们的成绩，班主任有的欢喜有的忧，为什么呢？大家都知道，现在流动人口多，很多家长、甚至一家全国跑。跨省读书的很多，转回的学生成绩很多不可信（这是我多年的见识，老师教上一段时间才知道）。转来转去，原装学生的总平均分、各科平均分、男女人数差距明显出来了，有的班主任运气差，前几名的学生跑得差不多了，有的班一个没跑，这不是学生的原因，而是家庭的原因。起跑线不同了，转入的学生就是走得多的班主任也不想要，一般均分，或者抽签。起跑线不同，有的班主任会一直抱怨，毕竟绝大部分是要带好几年。
怎么办呢？可能绝大部分学校无可奈何，一直这样分班下去，大家也习以为常。针对这种情况，我们这几年就改了一下，把起跑线尽量拉近：开学不分班，按原校报名组成临时班，一般一两天时间报完名，转入的重新考试，人数多就单独分班，这样一般一个晚上就能分好班（因为要考虑的因素多，走后门的也多，一般熬夜），这样以到校学生和实实在在的成绩分班，什么都基本相同的了，起码男女生是能分均匀了。分好后马上抽签。
有的可能会问，升学前的成绩可靠吗？对！不可靠！我们学校改革分班的第一年，我们把原来的期考成绩丢在一边，新生入学后，不管是转入的还是原装的，统统重新考试，再分班。第二年我们为了减少一次考试，我们就和有关领导沟通好，升学前的期考，我们派人（监考员一般是这些学生的班主任和授课教师）去监考、考完后把试卷带回本校，由我们阅卷，阅卷完后，再派人核查，对阅卷老师搞错一分的都要进行处理，绝不留情。这样成绩应该公平了。目前我认为这些办法是最公平的了。
正因为如此，我们就不能像在假期一样有时间慢慢分，要打起精神，速战速决，熬夜难免。如果有了你们开发的这个程序，我想今年不需要熬夜了，就是我们分 好了，班主任不满意，也可以快速分班，先向你们敬礼！谢谢！

香川群子

aoe1981 发表于 2014-7-25 11:52
好的，我抽空再研究下……有劳了……

索性写成函数过程以便任意调用。

1. Sub test()
   
2.     '在其它代码中调用的例子，非常简单 只需输入待分组学生总人数m、和分班班级数k
   
3. 
   
4.     '例子-1 排序后的2380个学生分到5个班级
   
5.     br = bj(2380, 5)
   
6.     Stop
   
7.    
   
8.     '例子2 排序后的2380个学生分到10个班级
   
9.     br = bj(2380, 10)
   
10.     Stop
    
11. End Sub
    
12. 
    
13. Function bj(m&, k&) 'm个学生排序后分派到k个班级 的自定义函数过程
    
14.     '分班要求 按班级错位分配： 12345 54321 23451 15432 34512 21543 45123 32154 51234 43215
    
15.     Dim i&, t&
    
16.     t = k ^ 2 * 2 '循环基数t
    
17.     ReDim a&(t - 1) '定义存放顺序循环结果的数组a
    
18.     For i = 0 To k - 1 '首先、生成第一组基数
    
19.         a(i) = i          '升序 01234
    
20.         a(k * 2 - i - 1) = i '降序 43210
    
21.     Next
    
22.     '接下来 生成余下的基数
    
23.     For i = k * 2 To t - 1
    
24.         a(i) = (a(i - k * 2) + 1) Mod k '其实只是比第1组基数+1 然后求余即可
    
25.     Next
    
26.     For i = 0 To t - 1
    
27.         a(i) = a(i) + 1 '为提高效率 +1转换为 1开始的班级序号
    
28.     Next
    
29.    
    
30.     '下面m个学生需要分班 则计算得到班级分配序号的一维数组
    
31.     ReDim b&(1 To m)
    
32. '    ReDim b&(1 To m, 1 To 1) '或生成多行单列的二维数组以便直接输出结果到工作表
    
33.     For i = 1 To m
    
34.         b(i) = a((i - 1) Mod t)
    
35. '        b(i, 1) = a((i - 1) Mod t)
    
36.     Next
    
37.    
    
38.     bj = b '这样得到一维或二维数组对应的分班序号结果数组bj
    
39. End Function

复制代码

张雄友

香川群子 发表于 2014-7-25 18:52
索性写成函数过程以便任意调用。

这还真不会用。

liyunfei099

夏秋梦 发表于 2014-7-25 17:54
没说假话，不是我们学校的，实实在在这个年级有6254人，是全县的一个年级，一共126个班级，你说我这个分析 ...

如果你是一个学校的教师而去分析全县的成绩，那教育局那些人是干什么的？

香川群子

改成调用分班函数的算法：

1. Option Explicit
   
2. Sub kagawa()
   
3.     Dim arr, xh, c&, i&, j&, k&, l&, m&, n&, t&, tms#
   
4.     tms = Timer '开始计时
   
5.     k = Sheets("分班").Range("g1") '获取分班数k
   
6. 
   
7.     Sheets("报名信息").Activate
   
8.     m = [a65536].End(3).Row - 2 '数据表有效行数m
   
9.     n = 17  '数据表有效列数n=17 (到Q列)
   
10.     Range("a3").Resize(m, n).Sort [c3], 1, [p3], , 2, , , 2 '按男女、总分 进行工作表倒序排序
    
11.     arr = Range("a3").Resize(m, n) '工作表排序后的数据读入数组arr
    
12.         
    
13.     ReDim brr(1 To k)
    
14.     ReDim crr(m \ k, 1 To n) '记录每个班信息的嵌套子数组
    
15.     For j = 1 To n
    
16.         crr(0, j) = Cells(2, j) '写入班级信息标题栏
    
17.     Next
    
18.     For j = 1 To k
    
19.         brr(j) = crr '嵌套数组初始化
    
20.     Next
    
21.         
    
22.     ReDim crr(1 To 10, 1 To 3)
    
23.     xh = bj(m, k) '对于排序后的学生数据表 直接调用分班函数得到分班班级序号
    
24.     For t = 1 To m Step k '按排序后的顺序 遍历原始数据各行
    
25.         i = i + 1 '插入各个班级是的当前行号
    
26.         For l = 0 To k - 1
    
27.             c = xh(t + l, 1)
    
28.             For j = 1 To n '第1-18列 照搬原始数据
    
29.                 If j = 5 Or j = 10 Then brr(c)(i, j) = "'" & arr(t + l, j) Else brr(c)(i, j) = arr(t + l, j)
    
30.             Next
    
31.             If arr(t + l, 3) = "男" Then crr(c, 1) = crr(c, 1) + 1 Else crr(c, 2) = crr(c, 2) + 1
    
32.             crr(c, 3) = crr(c, 3) + arr(t + l, 16)
    
33.         Next
    
34.     Next
    
35.     MsgBox Format(Timer - tms, "0.000s") '172个学生分成5个班计算耗时约 0.03-0.04秒
    
36.     Range("a3").Offset(, n).Resize(m) = xh '在报名信息表最后一列输出现在的分班班序
    
37.    
    
38.     Sheets("分班").Range("c2:e11") = crr '分班后统计结果输出
    
39. '    Stop
    
40. 
    
41.     '删去以前的工作表
    
42.     Application.DisplayAlerts = False
    
43.     For i = Sheets.Count To 3 Step -1
    
44.         Sheets(i).Delete
    
45.     Next
    
46.    
    
47.     '下面是新建工作表并逐个输出各班级结果
    
48.     For i = 1 To k
    
49.         Sheets.Add After:=Sheets(Sheets.Count)
    
50.         Sheets(Sheets.Count).Name = "班" & Right(0 & i, 2)
    
51.         Sheets(Sheets.Count).Range("a1").Resize(m \ k + 1, n) = brr(i)
    
52.     Next
    
53.     Sheets("分班").Activate
    
54. End Sub
    
55. Function bj(m&, k&) 'm个学生排序后 按错位法分班的函数过程
    
56.     '按班级错位分配： 12345 54321 23451 15432 34512 21543 45123 32154 51234 43215
    
57.     Dim i&, t&
    
58.     t = k ^ 2 * 2 '循环基数t
    
59.     ReDim a&(t - 1) '定义存放顺序循环结果的数组a
    
60.     For i = 0 To k - 1 '首先、生成第一组基数
    
61.         a(i) = i          '升序 01234
    
62.         a(k * 2 - i - 1) = i '降序 43210
    
63.     Next
    
64.     '接下来 生成余下的基数
    
65.     For i = k * 2 To t - 1
    
66.         a(i) = (a(i - k * 2) + 1) Mod k '其实只是比第1组基数+1 然后求余即可
    
67.     Next
    
68.     For i = 0 To t - 1
    
69.         a(i) = a(i) + 1 '为提高效率 +1转换为 1开始的班级序号 01234 -> 12345
    
70.     Next
    
71.    
    
72.     '下面m个学生需要分班 则计算得到班级分配序号的一维数组
    
73. '    ReDim b&(1 To m)
    
74.     ReDim b&(1 To m, 1 To 1) '或生成多行单列的二维数组以便直接输出结果到工作表
    
75.     For i = 1 To m
    
76. '        b(i) = a((i - 1) Mod t)
    
77.         b(i, 1) = a((i - 1) Mod t)
    
78.     Next
    
79.    
    
80.     bj = b '这样得到一维或二维数组对应的分班序号结果数组bj
    
81. End Function
    

复制代码

张雄友

香川群子 发表于 2014-7-25 19:45
改成调用分班函数的算法：

G1单元格，点击3 个班，或者 4个班时，会下标越界。只可以分5，或 10 个班？

香川群子

夏秋梦 发表于 2014-7-25 17:58
说点看法，谈点感想，大家不要见笑（主要是看到你们讨论的也是我多年来所想的），能开发这么好的程序来，为 ...

VBA帮助程序分班只能按以下思路：

1、特殊学生手工标记，不参与程序分配。
2、剩余学生，严格按照【男女】、【总分名次】排序后自动分配。

3.  手工添加特殊学生 并随时得到新的统计结果 (也用VBA程序)
4.  根据统计结果再次调整
重复3-4 直到统计结果令人满意。

…………
现在，第2个问题已经基本解决了。
所以，下一步就是：
1. 如何确定需要的统计项目、内容。
2. 如何提示需要再次调整的班级、学生。

呵呵

hlly888

达州张先生 发表于 2014-7-25 09:28
这段代码啊替换那里啊，用我的附件发个附件看看（不要改格式，试试能否运行）！谢谢！

   
分班统计表                                                                        班级数
班级        总人数        男        女        总分        平均分                11
合计        170        98        72        33145        460.35                
七1        15        9        6        2979        496.50                
七2        16        9        7        3114        444.86                
七3        16        9        7        3078        439.71                
七4        16        9        7        3072        438.86                
七5        16        9        7        3061        437.29                
七6        16        9        7        3050        435.71                
七7        16        9        7        3057        436.71                
七8        14        8        6        2827        471.17                
七9        15        9        6        2974        495.67                
七10        15        9        6        2971        495.17                
七11        15        9        6        2962        493.67