超级强大1：七年级新生分班，解决了重名与择班问题

aoe1981

达州张先生 发表于 2014-7-31 21:29
下面是语句“With .Sort”2003版不能用，请修改一下
With .Sort
        .SortFields.Clear

呵呵，不好意思，这段代码来源于在2010中的宏录制，我确实不知道在2003中的特点，什么地方该修改，这个你可以自己录制对比，也可以另发帖求助论坛行家了……

wxnxl

在楼主程序的基础上添加了一些功能：
1.添加分班准备（自动排序，填充名次）现在这个版本看来不需要名次了。我觉得分班前的准备工作其实还有许多是需要完善的，比如检查性别列是否填写完整等
2.添加同班重名统计（做了改善）
3.添加分数段统计功能（把另一个程序的功能移了过来）


求助：


调整择班后，继续回写“报名信息表”里的班级列！！
（若能直接就在“报名信息表”里调班，不生成分班表就更好，等分班工作完成后，再生成分班表。不然总觉得会有点混乱）



分班.rar (52.45 KB, 下载次数: 34)

2014-7-31 21:55 上传

点击文件名下载附件

张雄友

wxnxl 发表于 2014-7-31 21:55
在楼主程序的基础上添加了一些功能：
1.添加分班准备（自动排序，填充名次）现在这个版本看来不需要名次了 ...

分班准备的排名有问题，同样是262分，一个第一名，一个第二名。而且从第三行开始：


For i = 3 To h
    arr(i, 1) = i - 2

aoe1981

wxnxl 发表于 2014-7-31 21:55
在楼主程序的基础上添加了一些功能：
1.添加分班准备（自动排序，填充名次）现在这个版本看来不需要名次了 ...

博采众长，佩服佩服……
只是……我其实没有分过班……看了一部分灰袍法师的帖子，反倒糊涂了，到底什么是分班好的标准？
您的成绩分段统计的意思应该是说平均分的均衡不如成绩段的均衡，但是这样的考虑并未进入实际的分班过程……

wxnxl

aoe1981 发表于 2014-7-31 22:04
博采众长，佩服佩服……
只是……我其实没有分过班……看了一部分灰袍法师的帖子，反倒糊涂了，到底什么 ...

我有很丰富的分班经验，大概每年分3-4次班。今年开校前马上又要分班
我们分班的标准一般是这样的：
1.先根据择班人数，处理择班学生到指定班级，最后定出班级人数。（原则是平均分，有例外的时候）
2.考虑“优生”（比如没有分数的外地择校生，其实是优生，应该平均分到各个班）
3.班级的平均分尽量平衡，男女人数尽量平衡
4.如果能做到总分，每个学科的分数段都平衡就完美了！
实现这个过程，特别是第4步，一般是手工完成的，也是我一直认为最困难的一步。
现在有这个先分再调整的思路，我认为有希望解决了。


麻烦楼主，帮我改写一下，当调整择班学生后， 把班级号继续回写到“报名信息表”中。我有用途，谢谢！

wxnxl

张雄友 发表于 2014-7-31 22:03
分班准备的排名有问题，同样是262分，一个第一名，一个第二名。而且从第三行开始：

这个排名是根据楼主的意图写的，没有错。
现在如果改为以“总分”来调整择班学生，则不需要它了。

aoe1981

　　“当调整择班学生后”，我理解是这个意思，见下附件：
　　 5七年级分班(1234523451或1234554321分班及解决重名与择班).rar (50.07 KB, 下载次数: 54)

2014-7-31 22:28 上传

点击文件名下载附件

aoe1981

wxnxl 发表于 2014-7-31 22:16
这个排名是根据楼主的意图写的，没有错。
现在如果改为以“总分”来调整择班学生，则不需要它了。

　　我的回写方法，其实是走的捷径，当然，不知我是否理解正确了……

1. With 报名信息表
   
2.     zbl = .Rows(2).Find(what:="择班").Column
   
3.     xhl = .Rows(2).Find(what:="序号").Column
   
4.     xml = .Rows(2).Find(what:="姓名").Column
   
5.     xbl = .Rows(2).Find(what:="性别").Column
   
6.     mcl = .Rows(2).Find(what:="名次").Column
   
7.     zfl = .Rows(2).Find(what:="总分").Column
   
8.     bjl = .Rows(2).Find(what:="班级").Column
   
9.     sfzjhl = .Rows(2).Find(what:="身份证件号").Column
   
10.     lxdhl = .Rows(2).Find(what:="联系电话").Column
    
11.     h = 报名信息表.UsedRange.Rows.Count
    
12.     l = 报名信息表.UsedRange.Columns.Count
    
13.     For i = 3 To h
    
14.         If .Cells(i, zbl) <> "" And .Cells(i, zbl) <> .Cells(i, bjl) Then .Cells(i, bjl) = .Cells(i, zbl)
    
15.     Next i
    
16. End With
    

复制代码

　　以上来自于择班模块，增加的是13－15行。

aoe1981

wxnxl 发表于 2014-7-31 22:12
我有很丰富的分班经验，大概每年分3-4次班。今年开校前马上又要分班
我们分班的标准一般是这样的：
1.先 ...

附件在197楼……

wxnxl

aoe1981 发表于 2014-7-31 22:30
　　我的回写方法，其实是走的捷径，当然，不知我是否理解正确了……

　　以上来自于择班模块，增加的 ...

谢谢，这捷径确实走得优秀，我怎么没想到，呵呵。。。。


不过我对楼主这段代码有些地方还不是非常理解（我认为这就是你程序的精华）
Dim xb$, bj1%, bj2%, zf&, mymin&, myrow& '（三）交换学生
For i = 1 To h - 2
    If zbxx(i, zbl) = "" Then Exit For Else xb = zbxx(i, xbl): bj1 = zbxx(i, zbl): bj2 = zbxx(i, bjl): zf = zbxx(i, zfl)
    mymin = Abs(1000 - zf) '首次1000分进行比较
    For j = 3 To hh(bj1) '寻找最佳匹配学生
        If fbxx(bj1)(j, xbl) = xb And fbxx(bj1)(j, zbl) = "" Then '性别、择班控制，在同性别、未择班的学生中调换名次最接近的
            If Abs(fbxx(bj1)(j, zfl) - zf) < mymin Then mymin = Abs(fbxx(bj1)(j, zfl) - zf): myrow = j
        End If
    Next j
    For j = 1 To l '交换择班学生与对应班最佳匹配学生
        If j <> bjl Then '班级列不予交换
            zbjh(j) = fbxx(bj2)(h1(i), j)
            fbxx(bj2)(h1(i), j) = fbxx(bj1)(myrow, j)
            fbxx(bj1)(myrow, j) = zbjh(j)
        End If
    Next j
Next i

帮我解释一下红色部分的含义，谢谢
我主要是看不懂fbxx(bj1)(j, xbl)，这是什么写法？？？