Как определить, начинается ли перерыв / обед и заканчивается ли он между началом и концом смены в 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
Другие вопросы по тегам