求助大佬倒班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

乾坤一统

建议上传附件说明需求

沙漠热风

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

繁城凡心

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

小乌龟能有什么坏心思呢

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

冥羽

感谢，明天我要一下附件

山东大牌型男

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

想起我不完美

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

龟博士

感谢，应该是可以了