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


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

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


加好友 发短信
等级：三尾狐 帖子：645 积分：5680 威望：0 精华：0 注册：2017/4/7 12:15:00 		  发帖心情 Post By：2018/5/26 15:34:00 [只看该作者]

我把代码这么改了一下并增加了一个自定义函数testcount
Dim count As Integer = 0
Dim Names As List(Of Integer) = Args(0)
Dim Val As Integer = Args(1)

For t As Integer = 0 To (Names.Count-1)
           
If Names.Contains(Val)= True Then
    count = count+1
End If

Next

Return count

光星期一测试没问题，加上别的星期就卡住了
Dim lst100 As new List(of Integer) 
Dim lst200 As new List(of Integer) 
For Each dr As DataRow In DataTables("表b").DataRows
Select Case dr("星期")
 Case "星期一"
      dr("假期")="1,2"
Dim ids1 As String
Dim lst1 As new List(of Integer) 
Dim lst11 As new List(of Integer) 
Dim v1() As Integer = {1,2,3,4,5,6,7,8,9,10}
lst11.AddRange(v1)
 lst1.Add(1)
 lst1.Add(2)
lst11.Remove(1)
lst11.Remove(2)
Do  While lst1.count < 4     
Dim id As Integer = rand.Next(1,10)
          If lst1.Contains(id) = False And Functions.Execute("testcount",lst100,id) < 6 Then
        lst1.Add(id)
lst100.Add(id)
lst11.Remove(id)
ids1 = ids1 & id & ","
    End If
 
   Loop 
dr("晚班")= ids1.Trim(",")
ids1 = ""
Do  While lst1.count < 5     
Dim id As Integer = rand.Next(1,10)
          If lst1.Contains(id) = False And Functions.Execute("testcount",lst200,id) < 3 Then
        lst1.Add(id)
lst200.Add(id)
lst11.Remove(id)
ids1 = ids1 & id & ","
    End If
 
   Loop 
dr("早班")= ids1.Trim(",")
ids1 = ""

For t As Integer = 0 To (lst11.Count-1)
        ids1 = ids1 & lst11(t) & ","
    Next
dr("正常班")= ids1.Trim(",")
ids1 = ""

lst1.Clear
lst11.Clear
 lst1.Add(1)
 lst1.Add(2)
lst11.Remove(1)
lst11.Remove(2)
 回到顶部
帅哥，在线噢！
有点蓝
 小大  12楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：106147 积分：539852 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2018/5/26 16:42:00 [只看该作者]

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

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


加好友 发短信
等级：三尾狐 帖子：645 积分：5680 威望：0 精华：0 注册：2017/4/7 12:15:00 		  发帖心情 Post By：2018/5/26 16:46:00 [只看该作者]

早晚班是每天都要值的，一个月共30个早班60个晚班，均到每个人就是3个早班6个晚班啊。我是想有没有高效的办理可以统计集合中某个元素出现的次数？

 回到顶部
帅哥，在线噢！
有点蓝
 小大  14楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：106147 积分：539852 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2018/5/26 17:08:00 [只看该作者]

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

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


加好友 发短信
等级：三尾狐 帖子：645 积分：5680 威望：0 精华：0 注册：2017/4/7 12:15:00 		  发帖心情 Post By：2018/5/26 17:23:00 [只看该作者]

周六日是大家都不休，我的意思是尽量做到早晚班均等公平（不是绝对的），我把自定义函数去了，不卡了，老师帮我看看怎么控制这个每人
 下载信息  [文件大小：   下载次数： ]
图片点击可在新窗口打开查看点击浏览该文件:排班.table

早晚班的次数呢？

 回到顶部
帅哥，在线噢！
有点蓝
 小大  16楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：106147 积分：539852 威望：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
 回到顶部
帅哥哟，离线，有人找我吗？
liufucan
 小大  17楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：三尾狐 帖子：645 积分：5680 威望：0 精华：0 注册：2017/4/7 12:15:00 		  发帖心情 Post By：2018/5/26 18:10:00 [只看该作者]

好深奥，愣是没看懂，老师能不能稍微解释一下？

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


加好友 发短信
等级：三尾狐 帖子：645 积分：5680 威望：0 精华：0 注册：2017/4/7 12:15:00 		  发帖心情 Post By：2018/5/26 18:31:00 [只看该作者]

我大致看懂了
If dict.ContainsKey(idx) Then
        dict(idx)=dict(idx)+1
    Else
        dict.Add(idx,1)
    End If
字典的这个用法帮助好像没有介绍啊
[此贴子已经被作者于2018/5/26 18:30:57编辑过]
 回到顶部
帅哥哟，离线，有人找我吗？
liufucan
 小大  19楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：三尾狐 帖子：645 积分：5680 威望：0 精华：0 注册：2017/4/7 12:15:00 		  发帖心情 Post By：2018/5/26 19:00:00 [只看该作者]

晚班是两个人，该怎么处理呢？烦请老师指教，谢谢

 回到顶部
客人(60.221.*.*)
 小大  20楼


  发帖心情 Post By：2018/5/27 13:39: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)
Dim dict2 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
          
    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

    Dim lst10 As new List(of Integer)
 For Each key As Integer In ids1
        If dict2.ContainsKey(key) AndAlso dict2(key)>=6 Then
        Else
            lst10.Add(key)
        End If
    Next
   
 For i As Integer = 0 To 1 '开始洗牌
   
    Dim idx2 As Integer = lst10(rand.Next(0,lst10.count))
    ids2.Add(idx2)
    ids1.Remove(idx2)
    If dict2.ContainsKey(idx2) Then
        dict2(idx2)=dict2(idx2)+1
    Else
        dict2.Add(idx2,1)
    End If
  
Next

Select Case dr("星期")
        Case "星期六","星期日"
    For i As Integer = 0 To 6 '开始洗牌
        idx = ids1(rand.Next(0,ids1.count))
        ids2.Add(idx)
        ids1.Remove(idx)
    Next
Case Else
 For i As Integer = 0 To 4 '开始洗牌
        idx = ids1(rand.Next(0,ids1.count))
        ids2.Add(idx)
        ids1.Remove(idx)
    Next
End Select
    dr("早班")= ids2(0)
    dr("晚班")= ids2(1) & "," & ids2(2)
    dr("正常班")= ids2(3) & "," & ids2(4) & "," & ids2(5) & "," & ids2(6) & "," & ids2(7)
Next
DataTables("表b").save
 回到顶部
总数 31 上一页 1 2 3 4 下一页
RSS2.0 | Xhtml无图版 | Xslt无图版 Copyright © 2000 - 2018 foxtable.com Tel: 4000-810-820 粤ICP备11091905号
   Powered By Dvbbs Version 8.3.0
页面执行时间 0.05469 秒, 5 次数据查询