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
加好友 
发短信
Post By：2018/5/26 15:11:00 [显示全部帖子]
