如何按成绩和性别分班

aoe1981

aoe1981 发表于 2014-7-23 20:31
　　重大喜讯，传一组对比测试文件：
　　2380名学生分10班：
　　普通调用对象代码用时：60.1719秒，且进 ...

　　进一步优化了一下，不过这次不太明显，但是还是有所进步，现在2380名学生分10班需要用时4.4844秒，唉，提前了不到1秒，看来，在我的代码思路下到头了……不过，现在实用应该够了……附件如下：　　 性别总分分班(内存数组快).rar (187.04 KB, 下载次数: 191)

2014-7-23 23:58 上传

点击文件名下载附件

a68508122

数组，学习一下。。。。

aoe1981

hlly888 发表于 2014-7-23 23:11
分班前  已把  原始数据表按“总分”降序排序。
2380人  分班

优点如下：
1.代码效率出奇的高；
2.考虑到了身份证号和电话号码是文本型数据；
3.分班更均衡，表现在分班后各班平均分的标准差更小！
向你学习，只是你的代码很长，203行……

aoe1981

hlly888 发表于 2014-7-23 23:11
分班前  已把  原始数据表按“总分”降序排序。
2380人  分班

我现在借鉴你的部分做法，比如优化录制代码，减少对象调用……目前可到3.5秒左右，但你的依然在2秒左右，不是一个级别呀……
我的代码中使用了三维数组，只能一个元素给一个单元格这样赋值，不能实现整片区域的赋值，这可能是接下来时间消耗的重点……这点和算法有关了，不能改了呀……

aoe1981

hlly888 发表于 2014-7-23 23:11
分班前  已把  原始数据表按“总分”降序排序。
2380人  分班

　　我的最新附件运行效率超过你的了：
　　2380人分10班平均用时0.7000秒，在我的电脑上峰值会出现0.6500秒，呵呵……
　　附件如下：
　　 性别总分分班(终极优化71行代码可打印版).rar (155.66 KB, 下载次数: 311)

2014-7-24 15:29 上传

点击文件名下载附件

　　附件已更新，补加了打印信息沟通开关语句，现在生成可打印报表总共用时约需2秒。

aoe1981

hlly888 发表于 2014-7-23 23:11
分班前  已把  原始数据表按“总分”降序排序。
2380人  分班

我的代码总共89行，其中注释部分为打印设置代码，共18行，取消注释运行则耗时较长，约需10秒，但报表可以在A4纸上直接打印了……通过对比，可见，打印设置的代码效率极低！

aoe1981

hlly888 发表于 2014-7-23 23:11
分班前  已把  原始数据表按“总分”降序排序。
2380人  分班

　　以下是没有注释的完整代码（使用了香咱方法优化的代码，补加了打印信息沟通开关语句）：

1. Option Explicit
   
2. Public Sub fengban()
   
3. Dim n%, xx(), i&, bj%, m1&, m0&, h&, l&, tj(1 To 30, 1 To 3), t!, xbl%, zfl%, bjl%, nj$, xuex$, bjxx, gd, j&, k&, avgh%, j1%, i1%, lk
   
4. t = Timer
   
5. If 分班信息.[i4] = "" Then MsgBox "请先选择班级数！": Exit Sub
   
6. Application.DisplayAlerts = False
   
7. Application.ScreenUpdating = False
   
8. Application.PrintCommunication = False
   
9. lk = Array(2.75, 4.25, 8, 2.75, 4.25, 19, 8, 8, 16, 16, 11.5, 8.5, 4.25, 4.25, 4.25, 4.25, 4.25, 4.25)
   
10. With 分班信息
    
11.     n = .[i4].Value '班级数
    
12.     nj = .[i3].Value '年级
    
13.     xuex = .[i2].Value '学校
    
14. End With
    
15. With 报名信息表
    
16.     xx = .UsedRange '信息
    
17.     xbl = .Rows(2).Find(what:="性别").Column
    
18.     bjl = .Rows(2).Find(what:="班级").Column
    
19.     zfl = .Rows(2).Find(what:="总分").Column
    
20. End With
    
21. h = UBound(xx) '报名信息表行数
    
22. l = UBound(xx, 2) '报名信息表列数
    
23. m1 = 0: m0 = n / 2 '置换参数（男、女）
    
24. avgh = (h - 2) / n + 1 '分班后的平均行数
    
25. ReDim bjxx(1 To n)
    
26. ReDim gd(1 To avgh, 1 To l)
    
27. For i = 1 To n
    
28.     bjxx(i) = gd
    
29. Next i
    
30. For i = Sheets.Count To 3 Step -1 '删除表
    
31.     Sheets(i).Delete
    
32. Next i
    
33. For i = 3 To h
    
34.     If xx(i, xbl) = "男" Then
    
35.         j = j + 1: bj = (j + m1) Mod n: If bj = 0 Then bj = n
    
36.         tj(bj, 1) = tj(bj, 1) + 1 '统计班级男生人数
    
37.         If j Mod n = 0 Then m1 = m1 + 1
    
38.     Else
    
39.         k = k + 1: bj = (k + m0) Mod n: If bj = 0 Then bj = n
    
40.         tj(bj, 2) = tj(bj, 2) + 1 '统计班级女生人数
    
41.         If k Mod n = 0 Then m0 = m0 + 1
    
42.     End If
    
43.     xx(i, bjl) = bj '填充班级信息
    
44.     tj(bj, 3) = tj(bj, 3) + xx(i, zfl) '统计班级总分
    
45.     For j1 = 1 To l
    
46.         bjxx(bj)(tj(bj, 1) + tj(bj, 2), j1) = xx(i, j1) '班级信息赋值
    
47.     Next j1
    
48. Next i
    
49. 分班信息.Range("c4:e33") = tj
    
50. For i = 1 To n '表循环
    
51.     Sheets.Add after:=Sheets(Sheets.Count) '新建表
    
52.     With ActiveSheet
    
53.         .Range("f:f", "k:k").NumberFormatLocal = "@" '身份证号、电话为文本
    
54.         .Name = nj & i '工作表命名
    
55.         For k = 1 To l '列循环
    
56.             .Cells(2, k) = xx(2, k) '填充标题行
    
57.         Next k
    
58.         .[a3].Resize(avgh, l) = bjxx(i)
    
59.         With .UsedRange
    
60.             .Borders.LineStyle = xlContinuous '加边框
    
61.             .HorizontalAlignment = xlCenter '居中
    
62.         End With
    
63.         .Cells.EntireColumn.AutoFit '列自适应
    
64.         .[a1].Value = xuex & nj & "年级" & i & "班新生信息表" '添加标题并设置格式
    
65.         .[a1].Font.Size = 20
    
66.         .Range(.Cells(1, 1), .Cells(1, l)).HorizontalAlignment = xlCenterAcrossSelection '表头跨列居中
    
67.         For i1 = 0 To UBound(lk) '设置列宽
    
68.             .Columns(i1 + 1).ColumnWidth = lk(i1)
    
69.         Next i1
    
70.         .Rows(2).WrapText = True '标题行自动换行
    
71.         With .PageSetup '设置打印格式
    
72.             .PrintTitleRows = "$1:$2"
    
73.             .CenterFooter = "&N - &P"
    
74.             .LeftMargin = Application.InchesToPoints(0.236220472440945)
    
75.             .RightMargin = Application.InchesToPoints(0.236220472440945)
    
76.             .TopMargin = Application.InchesToPoints(0.748031496062992)
    
77.             .BottomMargin = Application.InchesToPoints(0.551181102362205)
    
78.             .HeaderMargin = Application.InchesToPoints(0.31496062992126)
    
79.             .FooterMargin = Application.InchesToPoints(0.31496062992126)
    
80.             .CenterHorizontally = True
    
81.             .Orientation = xlLandscape
    
82.             .PaperSize = xlPaperA4
    
83.         End With
    
84.     End With
    
85. Next i
    
86. Application.PrintCommunication = True
    
87. Application.DisplayAlerts = True
    
88. Application.ScreenUpdating = True
    
89. 分班信息.Activate
    
90. MsgBox Format(Timer - t, "0.0000")
    
91. End Sub
    

复制代码

　　这个代码总长度与我的一样，共89＋2＝91行。

aoe1981

达州张先生 发表于 2014-7-23 21:22
能否写一段生成各班分表的各列距设置。（行距好办，我有）。各列宽度如下： 列宽= Array(4.25, 4.25, 6.3 ...

　　以下楼层附件完全满足您的要求了（至少目前是的）：
　　http://club.excelhome.net/forum. ... 631&pid=7768119
　　特点：
　　1.运算部分效率极高，2380人分10班平均用时0.7000秒；
　　2.加入了打印设置代码，生成的报表可以在A4纸上直接打印。
　　备注：
　　1.该附件中的打印代码18行已经注释成了绿色，取消注释即可完整运行，生成可打印报表，但此时耗时明显延长，可见打印设置代码的效率极低。
　　2.其他的要求也做了修改，工作表中除了利用了函数，还有条件格式，结合起来为便捷。

lcjy11185

做得真好，学习了。

aoe1981

aoe1981 发表于 2014-7-24 14:39
　　以下楼层附件完全满足您的要求了（至少目前是的）：
　　http://club.excelhome.net/forum.php?mod= ...

　　惊喜补充一下：
　　现在才见识到以下开关的重要性：
　　Application.PrintCommunication = False
　　Application.PrintCommunication = True
　　我这前的代码忘了这两句，这会加上了，居然用时1.9秒左右，而且是生成可打印的报表！