wmf2014版主:系统日期修改到5月28日就提示下标越界!
回复 11楼 事业男儿
犯低级错误了,把pb函数里 j = Int(Abs(DateDiff("d", d, sdate)) / 7)改成 j = (Int(Abs(DateDiff("d", d, sdate)) / 7)) mod 3就可以了,下一句k=j mod 3可不要。
程序代码:Function pb(sdata As String, sdate As Date) As String
'本函数按照要求输出指定日期排班结果
'sdata为起始排班数据,格式是“起始日期,早班,中班,晚班",如"2017-5-3,张某,李某,王某"
'sdate为你指定的任何日期,返回结果为指定日期排班结果,早中晚班用逗号隔开,如"早班:王某,中班:李某,晚班:张某"
Dim i As Integer, j As Integer, k As Integer, d As String, b() As String, c() As String
b = Split(sdata, ",")
c = Split("早班,中班,夜班", ",")
d = b(0)
i = Weekday(d)
While i <> 3
d = DateAdd("d", -1, d)
i = Weekday(d)
Wend
j = (Int(Abs(DateDiff("d", d, sdate)) / 7)) Mod 3
i = 0
b(0) = ""
While i < 3
b(0) = b(0) & c(i) & ":" & b(j + 1) & ","
j = j + 1
If j > 2 Then j = 0
i = i + 1
Wend
pb = b(0)
End Function
Private Sub Command1_Click()
Dim a As String, b() As String
a = "2018-5-7,张某,李某,王某"
b = Split(pb(a, Date), ",")
Label1.Caption = Date & "日" & b(0)
Label2.Caption = Date & "日" & b(1)
Label3.Caption = Date & "日" & b(2)
End Sub
Private Sub Timer1_Timer() '修改系统日期的时候,方便自动测试!
Command1_Click
End Sub
程序代码:Function pb(sdata As String, sdate As Date) As String
'本函数按照要求输出指定日期排班结果
'sdata为起始排班数据,格式是“起始日期,早班,中班,晚班",如"2017-5-3,张某,李某,王某"
'sdate为你指定的任何日期,返回结果为指定日期排班结果,早中晚班用逗号隔开,如"早班:王某,中班:李某,晚班:张某"
Dim i As Integer, j As Integer, k As Integer, d As String, b() As String, c() As String
b = Split(sdata, ",")
c = Split("早班,中班,晚班", ",")
d = b(0)
i = Weekday(d)
While i <> 2
d = DateAdd("d", -1, d)
i = Weekday(d)
Wend
j = (Int(Abs(DateDiff("d", d, sdate)) / 7)) Mod 3
i = 0
b(0) = ""
While i < 3
b(0) = b(0) & c(i) & ":" & b(j + 1) & ","
j = j + 1
If j > 2 Then j = 0
i = i + 1
Wend
pb = b(0)
End Function
Private Sub Command1_Click()
Dim a As String
a = "2018-5-21,【张某】,【李某】,【王某】"
Label1.Caption = pb(a, "2018-5-7") '只要起始数据定了,2018-5-7这个日期可以随便换,都能正确返回该日期所在周的排班结果
End Sub