Как определить, начинается ли перерыв / обед и заканчивается ли он между началом и концом смены в Excel VBA
Excel VBA 2010:
У нас есть графики, которые работают 24/7. Я хотел бы, чтобы некоторая логика проверила, попадают ли времена перерыва / начала / окончания обеда в начало / конец смены. Я не хочу, чтобы кто-то планировал перерыв в нерабочее время.
Кроме того, я хотел бы проверить, будет ли перерыв / ланч продолжаться в течение другого перерыва или обеда. Я не хочу, чтобы кто-то планировал перерыв, скажем, в 10: 00-10: 15, пока у них есть график обеда с 10:00 до 10:30.
Заранее спасибо!
Вот образец моей логики:
ShiftStart = Format("20:45", "hh:mm")
Brk1Start = Format("23:00", "hh:mm")
Brk1End = Format("23:15", "hh:mm")
Brk2Start = Format("04:15", "hh:mm")
Brk2End = Format("04:30", "hh:mm")
LunchBrk = Format("02:00", "hh:mm")
LunchBrkEnd = Format("03:00", "hh:mm")
ShiftEnd = Format("06:15", "hh:mm")
If Brk1Start <= ShiftStart Or Brk1Start >= ShiftEnd Or _
Brk1End <= ShiftStart Or Brk1End >= ShiftEnd Then
HighlightRed
End If
1 ответ
Вот ты где!
Sub TestSchedule()
ShiftStart = CDate("20:45")
Brk1Start = CDate("23:00")
Brk1End = CDate("23:15")
Brk2Start = CDate("04:15")
Brk2End = CDate("04:30")
LunchBrk = CDate("02:00")
LunchBrkEnd = CDate("03:00")
ShiftEnd = CDate("06:15")
MsgBox IsWithin(ShiftStart, ShiftEnd, Brk1Start, Brk1End)
MsgBox IsWithin(ShiftStart, ShiftEnd, Brk2Start, Brk2End)
MsgBox IsWithin(ShiftStart, ShiftEnd, LunchBrk, LunchBrkEnd)
MsgBox IsWithin(ShiftStart, ShiftEnd, Brk1Start, Brk1End) And _
IsWithin(ShiftStart, ShiftEnd, Brk2Start, Brk2End) And _
IsWithin(ShiftStart, ShiftEnd, LunchBrk, LunchBrkEnd)
End Sub
Function IsWithin(dShiftStart, ByVal dShiftEnd, ByVal dBreakStart, ByVal dBreakEnd)
If dShiftEnd < dShiftStart Then dShiftEnd = dShiftEnd + 1
If dBreakEnd < dBreakStart Then dBreakEnd = dBreakEnd + 1
If dBreakStart < dShiftStart Then
dBreakStart = dBreakStart + 1
dBreakEnd = dBreakEnd + 1
End If
IsWithin = (dBreakStart > dShiftStart) And (dBreakEnd < dShiftEnd)
End Function
ОБНОВИТЬ
В ответ на ваш вопрос в комментарии здесь есть еще одна функция Function IsSeparate()
проверить, не перекрываются ли два перерыва, также Sub Test()
подготовка исходных данных вложенных массивов и Sub CheckSchedule()
выполнение всех необходимых проверок.
Sub Test()
Dim ShiftStart, Brk1Start, Brk1End, Brk2Start, Brk2End, LunchBrk, LunchBrkEnd, ShiftEnd, arrBrk1, arrBrk2, arrLunch, arrBrks
' set time valuse
ShiftStart = CDate("20:45")
Brk1Start = CDate("23:00")
Brk1End = CDate("23:15")
Brk2Start = CDate("04:15")
Brk2End = CDate("04:30")
LunchBrk = CDate("02:00")
LunchBrkEnd = CDate("03:00")
ShiftEnd = CDate("06:15")
' push breaks into arrays
arrBrk1 = Array(Brk1Start, Brk1End, "Break#1")
arrBrk2 = Array(Brk2Start, Brk2End, "Break#2")
arrLunch = Array(LunchBrk, LunchBrkEnd, "Lunch")
' push all break arrays into single consolidated array
arrBrks = Array(arrBrk1, arrBrk2, arrLunch)
' pass shift start, shift end, and the array to check
CheckSchedule ShiftStart, ShiftEnd, arrBrks
End Sub
Sub CheckSchedule(dShiftStart, dShiftEnd, arrBreaks)
Dim r, i, j
r = ""
For i = 0 to UBound(arrBreaks)
If Not IsWithin(dShiftStart, dShiftEnd, arrBreaks(i)(0), arrBreaks(i)(1)) Then r = r & arrBreaks(i)(2) & " is out of shift" & vbCrLf
For j = i + 1 to UBound(arrBreaks)
If Not IsSeparate(arrBreaks(i)(0), arrBreaks(i)(1), arrBreaks(j)(0), arrBreaks(j)(1)) Then r = r & arrBreaks(i)(2) & " and " & arrBreaks(j)(2) & " are overlapping" & vbCrLf
Next
Next
If r = "" Then r = "No issues were found"
MsgBox r
End Sub
Function IsSeparate(dStart1, dEnd1, dStart2, dEnd2)
Select Case True
Case dEnd1 < dStart1 And dEnd2 < dStart2
IsSeparate = False
Case dEnd1 < dStart1
IsSeparate = dEnd2 < dStart1 And dStart2 > dEnd1
Case dEnd2 < dStart2
IsSeparate = dEnd1 < dStart2 And dStart1 > dEnd2
Case Else
IsSeparate = dEnd1 < dStart2 Or dEnd2 < dStart1
End Select
End Function
Function IsWithin(dShiftStart, ByVal dShiftEnd, ByVal dBreakStart, ByVal dBreakEnd)
If dShiftEnd < dShiftStart Then dShiftEnd = dShiftEnd + 1
If dBreakEnd < dBreakStart Then dBreakEnd = dBreakEnd + 1
If dBreakStart < dShiftStart Then
dBreakStart = dBreakStart + 1
dBreakEnd = dBreakEnd + 1
End If
IsWithin = dBreakStart > dShiftStart And dBreakEnd < dShiftEnd
End Function