胖不了先生 发表于 2021-10-12 17:45:00

求助大佬倒班VBA程序编写

我们倒班时间是01:30-08:30,08:30-16:30,16:30-01:30
VBA原有程序是如下（00:30-08:30,08:30-16:30,16:30-00:30固定8小时倒班的），我应该怎么改才能让倒班时间7、8、9小时在程序里继续循环呢
Sub rqybc(R1, R3)
Dim Date01 As Date
If TimeValue(R1) = TimeValue("00:30") Then
Select Case (R1 Mod 8)
Case 0
R3.Value = 3
Case 1
R3.Value = 2
Case 2
R3.Value = 2
Case 3
R3.Value = 1
Case 4
R3.Value = 1
Case 5
R3.Value = 4
Case 6
R3.Value = 4
Case 7
R3.Value = 3
End Select
ElseIf TimeValue(R1) = TimeValue("08:30") Then
Select Case ((R1 - 1 / 3) Mod 8)
Case 0
R3.Value = 4
Case 1
R3.Value = 4
Case 2
R3.Value = 3
Case 3
R3.Value = 3
Case 4
R3.Value = 2
Case 5
R3.Value = 2
Case 6
R3.Value = 1
Case 7
R3.Value = 1
End Select
ElseIf TimeValue(R1) = TimeValue("16:30") Then
Select Case ((R1 - 2 / 3) Mod 8)
Case 0
R3.Value = 1
Case 1
R3.Value = 1
Case 2
R3.Value = 4
Case 3
R3.Value = 4
Case 4
R3.Value = 3
Case 5
R3.Value = 3
Case 6
R3.Value = 2
Case 7
R3.Value = 2
End Select
End If
End Sub

乾坤一统 发表于 2021-10-14 11:44:25

建议上传附件说明需求

沙漠热风 发表于 2021-11-6 18:22:40

用mod？？说明问题，上传附件，，

繁城凡心 发表于 2021-11-7 09:09:20

If TimeValue(R1) = TimeValue("01:30") Then

小乌龟能有什么坏心思呢 发表于 2021-11-18 00:49:53

别人问我的，我试了一下建倒班循环间隔7.8.9小时，没搞明白，感谢，明天看看我要一下附件

冥羽 发表于 2021-11-25 21:12:08

感谢，明天我要一下附件

山东大牌型男 发表于 2021-12-6 01:02:26

这个我试过了不行，倒班时间间隔7.8.9小时的，按照这样改就变成了01：30，09：30，17：30不符合要求了

想起我不完美 发表于 2021-12-18 09:55:36

Sub rqybc(R1, R3)
Dim Date01 As Date
If TimeValue(R1) = TimeValue("01:30") Then
Select Case ((R1-1/24) Mod 8)
Case 0
   R3.Value = 3
Case 1
   R3.Value = 2
Case 2
   R3.Value = 2
Case 3
   R3.Value = 1
Case 4
   R3.Value = 1
Case 5
   R3.Value = 4
Case 6
   R3.Value = 4
'Case 7
'R3.Value = 3
End Select
ElseIf TimeValue(R1) = TimeValue("08:30") Then
Select Case ((R1 - 1 / 3) Mod 8)
Case 0
   R3.Value = 4
Case 1
   R3.Value = 4
Case 2
   R3.Value = 3
Case 3
   R3.Value = 3
Case 4
   R3.Value = 2
Case 5
   R3.Value = 2
Case 6
   R3.Value = 1
Case 7
   R3.Value = 1
End Select
ElseIf TimeValue(R1) = TimeValue("16:30") Then
Select Case ((R1 - 2 / 3) Mod 8)
Case 0
   R3.Value = 1
Case 1
   R3.Value = 1
Case 2
   R3.Value = 4
Case 3
   R3.Value = 4
Case 4
   R3.Value = 3
Case 5
   R3.Value = 3
Case 6
   R3.Value = 2
Case 7
   R3.Value = 2
Case Else
   R3.Value = 3
End Select
End If
End Sub

龟博士 发表于 2022-1-5 20:27:49

感谢，应该是可以了
页: [1]
查看完整版本: 求助大佬倒班VBA程序编写