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)
Dim lst12 As new List(of Integer)
Dim v1() As Integer = {1,2,3,4,5,6,7,8,9,10}
lst12.AddRange(v1)
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
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
Dim lst11 As new List(of Integer)
For i As Integer = 0 To lst10.count-1 '准备初始的牌
If lst10(i)<>idx2 Then
lst11.add(lst10(i))
End If
Next
Dim idx3 As Integer = lst11(rand.Next(0,lst11.count))
ids2.Add(idx3)
ids1.Remove(idx3)
If dict2.ContainsKey(idx3) Then
dict2(idx3)=dict2(idx3)+1
Else
dict2.Add(idx3,1)
End If
lst11.clear
idx = ids1(rand.Next(0,ids1.count))
If lst12.Contains(idx) Then
lst12.Remove(idx)
dr("补休")= idx
ids1.Remove(idx)
Else
idx = ids1(rand.Next(0,ids1.count))
If lst12.Contains(idx) Then
lst12.Remove(idx)
dr("补休")= idx
ids1.Remove(idx)
End If
End If
Dim ids3 As New List(of Integer)
For i As Integer = 0 To ids1.count-1 '开始洗牌
idx = ids1(rand.Next(0,ids1.count))
ids3.Add(idx)
ids1.Remove(idx)
Next
dr("早班")= ids2(0)
dr("晚班")= ids2(1) & "," & ids2(2)
Dim ids4 As String
For t As Integer = 0 To (ids3.Count-1)
ids4 = ids4 & ids3(t) & ","
Next
dr("正常班")= ids4.Trim(",")
ids4= ""
Next
DataTables("表b").save