Foxtable(狐表) → 用户栏目 → 专家坐堂 → 请教一个排班问题


  共有4916人关注过本帖树形打印复制链接

主题：请教一个排班问题
帅哥哟，离线，有人找我吗？
有点蓝
 小大  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：106132 积分：539771 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2018/5/26 15:11:00 [显示全部帖子]

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("假期")
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")
    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)
    Dim ids1 As New List(of Integer) '用于存储洗牌前的位置
    Dim ids2 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
            Continue For
    End Select
    For i As Integer = 1 To 10 '准备初始的牌
        If lst1.Contains(i) = False Then
            ids1.add(i)
        End If
    Next
    For i As Integer = 0 To 7 '开始洗牌
        Dim idx As Integer = ids1(rand.Next(0,ids1.count))
        ids2.Add(idx)
        ids1.Remove(idx)
    Next
    dr("晚班")= ids2(0) & "," & ids2(1)
    dr("早班")= ids2(2)
    dr("正常班")= ids2(3) & "," & ids2(4) & "," & ids2(5) & "," & ids2(6) & "," & ids2(7)
Next
Tables("表b").save
 回到顶部
帅哥哟，离线，有人找我吗？
有点蓝
 小大  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：106132 积分：539771 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2018/5/26 16:42:00 [显示全部帖子]

这个不可能的，以早班为例，每天有8个人可以排，每人次数3，每月需要24个班次。但是6月份却只有17个班次可以排

 回到顶部
帅哥哟，离线，有人找我吗？
有点蓝
 小大  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：106132 积分：539771 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2018/5/26 17:08:00 [显示全部帖子]

没搞懂。你原来的算法是已经排除周六日的，所以6月份只剩下21个早班，在加上每周排除一个假期（看假期列），所以早班实际上能排的只有17个班次

 回到顶部
帅哥哟，离线，有人找我吗？
有点蓝
 小大  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：106132 积分：539771 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2018/5/26 17:25:00 [显示全部帖子]

类似这种，这里只处理了早班


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("假期")
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")
    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
Dim dict As new Dictionary(of Integer,Integer)
For Each dr As DataRow In DataTables("表b").DataRows
    Dim lst1 As new List(of Integer)
    Dim ids1 As New List(of Integer) '用于存储洗牌前的位置
    Dim ids2 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
            Continue For
    End Select
    For i As Integer = 1 To 10 '准备初始的牌
        If lst1.Contains(i) = False Then
            ids1.add(i)
        End If
    Next
    Dim lst9 As new List(of Integer)
    For Each key As Integer In ids1
        If dict.ContainsKey(key) AndAlso dict(key)>=3 Then
        Else
            lst9.Add(key)
        End If
    Next
    Dim idx As Integer = lst9(rand.Next(0,lst9.count))
    ids2.Add(idx)
    ids1.Remove(idx)
    If dict.ContainsKey(idx) Then
        dict(idx)=dict(idx)+1
    Else
        dict.Add(idx,1)
    End If
    For i As Integer = 0 To 6 '开始洗牌
        idx = ids1(rand.Next(0,ids1.count))
        ids2.Add(idx)
        ids1.Remove(idx)
    Next
    dr("早班")= ids2(0)
    dr("晚班")= ids2(1) & "," & ids2(2)
    dr("正常班")= ids2(3) & "," & ids2(4) & "," & ids2(5) & "," & ids2(6) & "," & ids2(7)
Next
Tables("表b").save
 回到顶部
RSS2.0 | Xhtml无图版 | Xslt无图版 Copyright © 2000 - 2018 foxtable.com Tel: 4000-810-820 粤ICP备11091905号
   Powered By Dvbbs Version 8.3.0
页面执行时间 0.04492 秒, 5 次数据查询