Question

考虑到开始时间和结束时间。

如同8：30-10：30，我可以计算持续时间（分钟） - > 120

情况：每45分钟，短暂的5分钟休息。

将是8：30-9：15（第一节）（累计45分钟），9：15-9：20（1休息时间），9：20-10：05（2节）（累计90分钟）），10：05-10：10（2个休息时间）.10：10-10：40（3个疗程）（提醒时间30分钟= 120-90），没有第三次休息

我只想输出：8：30-10：40（开始到结束）＆amp;每个休息时间（开始和结束）：9：15至9：20,10：10-10：40

要执行此操作的任何Excel或VBA解决方案吗？

样本输入可以是：830-12：34,930-1732,9：30-23：67

我目前正在工作:(总分钟为158） 8：30-11：08 首先计算持续时间

输入：830,11：08

输出：图片中的红线：新的结束时间，每个休息时间开始，每个休息时间结束

Answer 1

将计算以下用户定义的函数，不包括中断。

Function getTime(s, e)
    Dim wf As WorksheetFunction
    Dim myTime As Date, t As Date
    Dim i As Integer, n As Integer
    Dim Other()

    Set wf = WorksheetFunction
    If s > e Then
        myTime = e - s + 1
        s = 0
    Else
        myTime = e - s
    End If
    t = s + TimeSerial(0, 45, 0)
    Do
        n = n + 2
        ReDim Preserve Other(1 To n)
        Other(n - 1) = t
        Other(n) = t + TimeSerial(0, 5, 0)
        t = t + TimeSerial(0, 50, 0)
    Loop While e > t
    With wf
        For i = LBound(Other) To UBound(Other) Step 2
            If Other(i + 1) > e Then Exit For
            myTime = myTime - (.Min(e, Other(i + 1)) - .Max(s, Other(i)))
        Next i
    End With
    getTime = myTime * 1440
End Function

休息时间将会出现在桌面上。

Sub test()
 Dim s, e

 s = Range("b9")
 e = Range("B27")

 getTimetable s, e, Range("b10")

End Sub
Sub getTimetable(s, e, target As Range)
    Dim wf As WorksheetFunction
    Dim myTime As Date, t As Date
    Dim i As Integer, n As Integer
    Dim Other()

    Set wf = WorksheetFunction
    If s > e Then
        myTime = e - s + 1
        s = 0
    Else
        myTime = e - s
    End If
    t = s + TimeSerial(0, 45, 0)
    Do
        n = n + 2
        ReDim Preserve Other(1 To n)
        Other(n - 1) = t
        Other(n) = t + TimeSerial(0, 5, 0)
        t = t + TimeSerial(0, 50, 0)
    Loop While e > t
    With wf
        For i = LBound(Other) To UBound(Other) Step 2
            If Other(i + 1) > e Then Exit For
            myTime = myTime - (.Min(e, Other(i + 1)) - .Max(s, Other(i)))
        Next i
    End With
    If n Then
        target.Resize(n) = WorksheetFunction.Transpose(Other)
    End If

End Sub

Answer 2

行。以下代码计算过程中的每次。要测试它，请获取空白工作表，在B2中输入开始时间，在C2中输入结束时间，然后运行代码。在标准代码模块中安装代码。标准代码模块的默认名称为Module1。它不是新工作簿中可用的模块。你必须添加它。（在VBE屏幕左侧的Project Explorer窗口中右键单击VBA项目，然后选择Insert和Module。）

Option Explicit

Enum Nws                                ' worksheet navigation
    ' 15 Jan 2018
    NwsFirstResultRow = 4
    NwsCaption = 1                      ' 1 = column A
    NwsStart                            ' each period's start time
    NwsEnd                              ' 3 = C
End Enum

Sub CalculateRestTimes()
    ' 15 Jan 2018

    Const StartTime As String = "B2"    ' change as required
    Const EndTime As String = "C2"      ' change as required
    Const BreakTime As Long = 5
    Const WorkPeriod As Long = 45

    Dim Tstart As Double, Tend As Double
    Dim Twork As Double, Tbreak As Double
    Dim Rng As Range
    Dim R As Long
    Dim p As Integer

    Twork = Round(WorkPeriod / 1440, 6)
    Tbreak = Round(BreakTime / 1440, 6)
    Application.ScreenUpdating = False
    With Worksheets("RestTimes")        ' change as required
        Tstart = Round(Val(.Range(StartTime).Value2), 6)
        Tend = Round(Val(.Range(EndTime).Value2), 6)
        If Tstart = 0 Or Tend = 0 Then
            MsgBox "Start or end time is not entered correctly.", _
                   vbCritical, "Invalid or missing entry"
        End If

        R = Application.Max(.Cells(.Rows.Count, NwsCaption).End(xlUp).Row, NwsFirstResultRow)
        Set Rng = Range(.Cells(NwsFirstResultRow, NwsCaption), .Cells(R, NwsEnd))
        Rng.ClearContents
        R = NwsFirstResultRow - 1

        Do While Tstart < Tend
            R = R + 1
            p = p + 1
            .Cells(R, NwsCaption).Value = Ordinal(p) & " period"
            .Cells(R, NwsStart).Value2 = Tstart
            Tstart = Application.Min((Tstart + Twork), Tend)
            .Cells(R, NwsEnd).Value2 = Tstart
            If (Tstart + (20 / 1440)) <= Tend Then
                R = R + 1
                .Cells(R, NwsCaption).Value = Ordinal(p) & " rest"
                .Cells(R, NwsStart).Value2 = Tstart
                Tend = Tend + Tbreak
                Tstart = Tstart + Tbreak
                .Cells(R, NwsEnd).Value2 = Tstart
            Else
                .Cells(R, NwsEnd).Value2 = Tend
                Exit Do
            End If
        Loop

        Set Rng = Range(.Cells(NwsFirstResultRow, NwsStart), .Cells(R, NwsEnd))
        Rng.NumberFormat = "HH:mm"
    End With
    Application.ScreenUpdating = True
End Sub

Private Function Ordinal(ByVal n As Integer) As String
    ' 13 Jan 2018

    Dim Suff As Variant
    Dim i As Integer

    Suff = Array("th", "st", "nd", "rd")
    i = n Mod 10
    Ordinal = CStr(n) & Suff(IIf(i > 3, 0, i))
End Function

Answer 3

请尝试此公式，其中开始时间为B2，结束时间为C2。该公式将为原始工作时间的每45分钟返回一个新的结束时间，延长5分钟。

=$C2+(INT(($C2+IF($B2>$C2,1,0)-$B2)*1440/45)*5/1440)

如果净工作时间内有9个或更多休息时间，我认为公式应该返回错误的结果。如果真的如此，如果这是一个问题，可以调整。

如何计算时间随休息时间延长

3 个答案: