以文本方式查看主题 - Foxtable(狐表) (http://foxtable.net/bbs/index.asp) -- 专家坐堂 (http://foxtable.net/bbs/list.asp?boardid=2) ---- 分组分道问题 (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=45753) |
||||
-- 作者:aygp -- 发布时间:2014/2/10 16:01:00 -- 分组分道问题 要求: 1、参加比赛的单位有多个,每个单位又有多个运动员参加相同项目的比赛,所以在分组时尽量避免同一个单位的多个运动员分在同一个组里; 2、比赛跑道中4、5道最好,依次为3、6道,2、7道,1、8道。为了公平,每个单位尽量均等的分配1至8道。如管理系某个运动员在1组中分配了4道, 那么管理系的另一个运动员在2组中最好分配1道或者8道。 3、以上只是理论上的要求,只要大至符合就可以了,表B是个参考。 请问“分组分道”按键代码应该如何编写? |
||||
-- 作者:Bin -- 发布时间:2014/2/10 16:10:00 -- 呵呵,单纯的随机分配会比较容易. 加上这些要求的话就要费不少功夫了. 你看看直接随机能否满足你需求.
|
||||
-- 作者:ybil -- 发布时间:2014/2/10 17:01:00 -- 以前用易表做过,不知易表论坛能否搜索过? |
||||
-- 作者:aygp -- 发布时间:2014/2/10 17:31:00 -- 此附件为商业版 |
||||
-- 作者:ybil -- 发布时间:2014/2/10 17:36:00 -- 参考: http://www.egrid2000.com/dvbbs/dispbbs.asp?boardid=2&id=9748&authorid=0&page=0&star=1
|
||||
-- 作者:aygp -- 发布时间:2014/2/10 17:55:00 -- 易表可以解决,狐表就肯定可以解决,只是我水平太差,只有求助高手了! |
||||
-- 作者:aygp -- 发布时间:2014/2/10 20:09:00 -- 需要说明一下,每次操作时都是对一个比赛项目进行分组分道,比如说先选择100M项目,再点击“分组分道”按键,对100M项目进行分组分道。完成后再选择200M项目,操作同上。直至全部操作完成。 |
||||
-- 作者:有点甜 -- 发布时间:2014/2/10 21:49:00 -- 如下代码,感觉这样快速和简单一些,你多试几次结果应该能满足的。不足8个人的,暂时不排,留给你做调整。 Dim dt As DataTable = DataTables("表A") dt.ReplaceFor("组别", Nothing, Tables("表A").Filter) dt.ReplaceFor("道次", Nothing, Tables("表A").Filter) Dim dws As List(Of String) = dt.GetValues("单位", Tables("表A").Filter) Dim filter As String = iif(Tables("表A").Filter > "", " and 组别 is null and 道次 is null and " & Tables("表A").Filter, " and 组别 is null and 道次 is null") Dim rcount As Integer = Tables("表A").Rows.count Dim msg As String = "" For i As Integer = 1 To rcount \\ 8 Dim ary(3) As String For j As Integer = 1 To 4 Dim giveup As Integer = 0 Do While giveup < 10 Dim dw As String = dws(Rand.Next(dws.count)) If Array.Indexof(ary, dw) > -1 Then giveup += 1 Else Dim fdr As DataRow = dt.Find("单位 = \'" & dw & "\'" & filter) If fdr IsNot Nothing Then fdr("组别") = i fdr("道次") = j ary(j-1) = dw Exit Do End If End If Loop If giveup >= 10 Then Do While 1 Dim dw As String = dws(Rand.Next(dws.count)) Dim fdr As DataRow = dt.Find("单位 = \'" & dw & "\'" & filter) If fdr IsNot Nothing Then fdr("组别") = i fdr("道次") = j ary(j-1) = dw Exit Do End If Loop End If Next For j As Integer = 5 To 8 Dim fdr As DataRow = dt.Find("单位 = \'" & ary(j-5) & "\'" & filter) If fdr Is Nothing Then msg += "(" & i & "," & j & ")缺值" & vbcrlf Else fdr("组别") = i fdr("道次") = j End If Next Next output.show(msg) Tables("表A").sort = "组别, 道次" [此贴子已经被作者于2014-2-10 21:50:32编辑过]
|
||||
-- 作者:aygp -- 发布时间:2014/2/10 22:36:00 -- 谢谢甜老师!就是这个意思,基本上达到要求了。如果能每个比赛项目只点1到2次就不缺道就更好了。 |
||||
-- 作者:y2287958 -- 发布时间:2014/2/11 13:09:00 -- 试试这个
|