以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.com/bbs/index.asp)
--  专家坐堂  (http://foxtable.com/bbs/list.asp?boardid=2)
----  分组分道问题  (http://foxtable.com/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是个参考。
请问“分组分道”按键代码应该如何编写?
 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:分组分道.rar





--  作者: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
--  

试试这个

 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:分组分道.zip