- Foxtable(狐表) (http://foxtable.com/bbs/index.asp)
-- 专家坐堂 (http://foxtable.com/bbs/list.asp?boardid=2)
---- 分班 (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=178458)
-- 发布时间：2022/7/5 18:58:00
-- 分班
此主题相关图片如下：orw$l)g{zzum)t%1i7ke12.png
Dim tb5 As Table= Tables("学生信息A_table5")
Dim bs As Integer= e.Form.Controls("combobox3").text
Dim j As Integer=1
tb5.sort="性别,学生姓名"
For Each r As Row In tb5.Rows
If r("指定分班")=Nothing
r("预分班")=j
j=j+1
End If
If j=bs+1
j=1
End If
Next\'
老师：请问上面的代码想实现按班数依次按1，2，3，4，5，6，7，8班分别排起走，现在想实现如果前面有一个指定先安排了7班的男生，就在第一轮出现7的男生就跳过，如果前面出现了两个指定安排的7班的男生，就在第二轮出现7的男生也跳过，总之就是分下的结果各班人数基本相同，性别比例基本相同，这怎么改，没想到好的办法，请帮指导下这个如何来优化改进。谢谢
-- 发布时间：2022/7/5 20:42:00
--
试试
Dim tb5 As Table = Tables("学生信息A_table5")
Dim bs As Integer = e.Form.Controls("combobox3").text
Dim j As Integer = 1
tb5.sort = "性别,学生姓名"
Dim lst As New List(Of Integer)
Dim lst2 As New List(Of Integer)
For i As Integer = 1 To bs
lst.Add(i)
Next
Dim ssr() As Integer = lst.ToArray
Dim k As Integer = 0
Dim cnt As Integer = tb5.Rows.count - 1
Dim r As Row
Do While k <= cnt
r = tb5.Rows(k)
k = k + 1
If r.IsNull("指定分班") Then
If lst.Count = 0 Then
lst.AddRange(ssr)
For n As Integer = lst2.Count - 1 To 0 Step - 1
If lst.Contains(lst2(n)) Then
lst.Remove(lst2(n))
lst2.RemoveAt(n)
End If
Next
End If
r("预分班") = lst(0)
lst.RemoveAt(0)
Else
Dim zd As Integer = r.IsNull("指定分班")
If lst.Contains(zd) Then
r("预分班") = zd
lst.Remove(zd)
Else
lst2.Add(zd)
End If
End If
Loop
-- 发布时间：2022/7/5 22:04:00
--
此主题相关图片如下：}n$z5xs3tl2k~c47rmb`l.png
上面代码效果一样呢，结果如图，我是想，如上面有一个指定了7班的学生且性别为男，那么第一轮出现7班那个男生位置的就不再安7班，而安8班，这样让各班总数均衡，性别也尽量均衡
[此贴子已经被作者于2022/7/5 22:08:54编辑过]
-- 发布时间：2022/7/5 22:11:00
--
我测试了，如果多指定先安几个7班，最后强果7班人数超过平均数就是几个，也就是想指定安的个数应影响8个班的平均数和性别平均数
-- 发布时间：2022/7/5 22:28:00
--
请上传实例测试
-- 发布时间：2022/7/5 23:00:00
--
Dim tb5 As Table= Tables("学生信息A_table5")
Dim bs As Integer= e.Form.Controls("combobox3").text
Dim j As Integer=1
tb5.sort="性别,学生姓名"
For Each r As Row In tb5.Rows
If r("指定分班")=Nothing
Dim rf As DataRow =tb5.DataTable.Find("指定分班= \'" & j & "\' and 性别= \'" & r("性别") & "\' and 备注 is null ")
If rf IsNot Nothing
rf("备注")="冲销"
j=j+1
r("预分班")=j
Else
r("预分班")=j
End If
j=j+1
End If
If j=bs+1
j=1
End If
Next\'
-- 发布时间：2022/7/5 23:01:00
--
老师，我这样实现了，但很low，如何优化更好呢，增加了个备注列，如果不用备注列有什么办法解决没有
[此贴子已经被作者于2022/7/5 23:04:59编辑过]