主题：请教一个排班问题

 【你本来说早班2个人的】

比如 30天，10个人，一个人6个早班、6个晚班。然后随机排列早班、随机排列晚班。

用洗牌的方式，30张牌，每个人3张牌（写自己名字），然后洗牌打乱，按顺序抽取，对应第一张对应1号，第二张对应2号......这样确定第一个早班人

同理，确定第二个早班人，晚班人1，晚班人2。

得到的4组数据，1号可能有重复的人（比如 张三、李四、张三、王五），这个时候，就要交换去重复。

如果1号那天，第一个早班和第一个晚班重复，这个时候，把看2号晚班的人是否张三（直到找到不是张三的人），交换这两个人。一直往后，排除所有重复值。

方法二：随机抽取，类似这种

http://www.foxtable.com/bbs/dispbbs.asp?BoardID=2&ID=114803&skin=0

用4楼方法，或者2楼方法，得到排班以后，节假日的去掉或者顺延，休息日的调换横向调换一下人员的顺序即可。

随机抽取，参考

http://www.foxtable.com/bbs/dispbbs.asp?BoardID=2&ID=109227&skin=0

http://www.foxtable.com/webhelp/scr/2963.htm

重复问题：

得到的3组数据（早班1个、晚班2个），比如1号可能有重复的人（比如 张三、张三、王五），这个时候，就要交换去重复。

如果1号那天，第一个早班和第一个晚班重复，这个时候，把看2、3、4、5.....号晚班的人是否张三（直到找到不是张三的人），交换这两个人。一直往后，可以排除所有重复值。

参考代码，看懂代码

DataTables("表b").DeleteFor("")
Dim y As Integer = 2018 '指定年
Dim m As Integer = 6 '指定月

Dim days As Integer = Date.DaysInMonth(y,m) '返回指定 年\月 的天数
Dim ed As Date = New Date(y,m,Days)
Dim sd As Date = New Date(y,m,1) '从指定日期开始

Dim zbrys As List(Of String) = DataTables("人员").GetValues("序号","姓名 is not null","_sortkey")

Dim d As Date = sd

Dim dt As DataTable = DataTables("假期")
Dim drs As new Dictionary(of String, Row)
Do While d <= ed
    Dim fdr As DataRow = dt.Find("日期 = #" & d & "#")
    If fdr Is Nothing Then
        Dim nr As Row = Tables("表b").AddNew
        nr("日期") = d
        nr("星期") = Format(d, "dddd")
        drs.add(d, nr)
    Else
        Dim nr As Row = Tables("表b").AddNew
        nr("日期") = d
        nr("星期") = Format(d, "dddd")
        nr("假期") = fdr("说明")
    End If
    d = d.AddDays(1)
Loop
Tables("表b").save
For Each dr As DataRow In DataTables("表b").DataRows
    Dim lst1 As new List(of Integer)
    Select Case dr("星期")
        Case "星期一"
            dr("假期")="1,2"
            lst1.Add(1)
            lst1.Add(2)
        Case "星期二"
            dr("假期")="3,4"
            lst1.Add(3)
            lst1.Add(4)
        Case "星期三"
            dr("假期")="5,6"
            lst1.Add(5)
            lst1.Add(6)
        Case "星期四"
            dr("假期")="7,8"
            lst1.Add(7)
            lst1.Add(8)
        Case "星期五"
            dr("假期")="9,10"
            lst1.Add(9)
            lst1.Add(10)
        Case Else
    End Select
Next
'洗牌填入数据
Dim cnt As Integer = drs.count
Dim ids(cnt - 1) As String
Dim ids1(cnt - 1) As String
Dim ids2(cnt - 1) As String
Dim idx As Integer = 0
Dim i As Integer = 0
For Each key As String In drs.keys
    ids(i) = zbrys(idx)
    ids1(i) = zbrys(idx)
    ids2(i) = zbrys(idx)
    If idx >= zbrys.Count-1 Then
        idx = 0
    Else
        idx+=1
    End If
    i += 1
Next
For j As Integer = 0 To cnt \ 2 '洗牌次数
    Dim id1 As Integer = rand.Next(0,cnt)
    Dim id2 As Integer = rand.Next(0,cnt)
    Dim vid As Integer = ids(id1)
    ids(id1) = ids(id2)
    ids(id2) = vid
Next
i = 0
For Each key As String In drs.keys
    drs(key)("早班") = ids(i)
    i += 1
Next
For j As Integer = 0 To cnt \ 2 '洗牌次数
    Dim id1 As Integer = rand.Next(0,cnt)
    Dim id2 As Integer = rand.Next(0,cnt)
    Dim vid As Integer = ids1(id1)
    ids1(id1) = ids1(id2)
    ids1(id2) = vid
Next
i = 0
For Each key As String In drs.keys
    drs(key)("晚班") = ids1(i)
    i += 1
Next
For j As Integer = 0 To cnt \ 2 '洗牌次数
    Dim id1 As Integer = rand.Next(0,cnt)
    Dim id2 As Integer = rand.Next(0,cnt)
    Dim vid As Integer = ids2(id1)
    ids2(id1) = ids2(id2)
    ids2(id2) = vid
Next
i = 0
For Each key As String In drs.keys
    drs(key)("晚班") &= "," & ids2(i)
    i += 1
Next

'处理重复数据
For Each key As String In drs.keys
    Dim r = drs(key)
    If r("早班") = Nothing Then Continue For
    Dim jq() As String = r("假期").split(",")
    Dim ls As new List(of String)
    If jq.length > 0 Then
        ls.AddRange(jq)
        If array.indexof(jq, r("早班")) >= 0 Then '早班重复
            For Each ckey As String In drs.keys
                If ckey <= r("日期") Then Continue For
                If ls.contains(drs(ckey)("早班")) = False Then
                    Dim temp = r("早班")
                    r("早班") = drs(ckey)("早班")
                    drs(ckey)("早班") = temp
                    Exit For
                End If
            Next
        End If
    End If
    ls.add(r("早班"))
    Dim wb1 = r("晚班").split(",")(0)
    Dim wb2 = r("晚班").split(",")(1)
    If ls.Contains(wb1) Then '第一个晚班重复
        For Each ckey As String In drs.keys
            If ckey <= r("日期") Then Continue For
            Dim cwb1 = drs(ckey)("晚班").split(",")(0)
            Dim cwb2 = drs(ckey)("晚班").split(",")(1)
            If ls.contains(cwb1) = False Then
                r("晚班") = cwb1 & "," & wb2
                drs(ckey)("晚班") = wb1 & "," & cwb2
                Exit For
            End If
        Next
    End If
    wb1 = r("晚班").split(",")(0)
    wb2 = r("晚班").split(",")(1)
    ls.add(wb1)
    If ls.Contains(wb2) Then '第二个晚班重复
        For Each ckey As String In drs.keys
            If ckey <= r("日期") Then Continue For
            Dim cwb1 = drs(ckey)("晚班").split(",")(0)
            Dim cwb2 = drs(ckey)("晚班").split(",")(1)
            If ls.contains(cwb2) = False Then
                r("晚班") = wb1 & "," & cwb2
                drs(ckey)("晚班") = cwb1 & "," & wb2
                Exit For
            End If
        Next
    End If
    wb2 = r("晚班").split(",")(1)
    ls.add(wb2)
    Dim str As String = ""
    For Each s As String In zbrys
        If ls.Contains(s) = False Then
            str &= s & ","
        End If
    Next
    r("正常班") = str.trim(",")
Next

DataTables("表b").save

请上传具体foxtable实例、代码说明。

DataTables("表b").DeleteFor("")

Dim frm As winform.Form = Forms("窗口1")
Dim y As Integer = frm.Controls("ComboBox1").value '指定年
Dim m As Integer = frm.Controls("ComboBox2").value '指定月

DataTables("表b").save