“Age is an issue of mind over matter. If you don’t mind, it doesn’t matter.” [Mark Twain]

Name

sbTimeAdd() - Addiere eine positive Zeit zu einem Datum mit Uhrzeit, wobei lediglich spezifizierte Zeitintervalle pro Wochentag und Feiertag berücksichtigt werden und auch eine definierte tägliche Pausenzeit abgezogen wird, falls die entsprechende tägliche definierte Arbeitszeit überschritten wird.

Synopsis

sbTimeAdd(dt, dh, vwh [, vHolidays] [, dtBreakLimit] [, dtBreakDuration])

Beschreibung

Addiere eine positive Zeit zu einem Datum mit Uhrzeit, wobei lediglich spezifizierte Zeitintervalle pro Wochentag und Feiertag berücksichtigt werden und auch eine definierte tägliche Pausenzeit abgezogen wird, falls die entsprechende tägliche definierte Arbeitszeit überschritten wird.

Optionen

dt - Datum und Uhrzeit auf die die Zeit dh addiert werden soll

dh - Zeit als Datentyp Double die auf dt addiert werden soll

vwh - 8 mal 2 Matrix, definiert die Startzeiten und Endzeiten pro Wochentag und für Feiertage, die erste Zeile für Montage, die achte für Feiertage

vHolidays - Optional. Liste der Feiertage (ganzzahlige Datumswerte). Für die Tage in dieser Liste werden nicht die Wochentagszeiten von vwh genommen, sondern die Feiertagszeiten in der achten Zeile

dtBreakLimit - Optional. Tägliche Arbeitszeit ab der die Pausenzeit dtBreakDuration abgezogen werden muss

dtBreakDuration - Optional. Pausenzeit die von der aggregierten täglichen Arbeitszeit dtBreakLimit abgezogen muss, falls diese erreicht wird

Beispiel

sbTimeAdd_Example1

Siehe Auch

sbTimeDiff - Berechne die Zeit zwischen zwei Zeitpunkten, aber zähle lediglich die spezifizierten Zeiten pro Wochentag oder Feiertag minus Pausen, falls die tägliche Arbeitszeit definierte Grenzwerte überschreitet.

Appendix Programmcode sbTimeAdd

Bitte den Haftungsausschluss im Impressum beachten.

Enum mc_Macro_Categories
    mcFinancial = 1
    mcDate_and_Time
    mcMath_and_Trig
    mcStatistical
    mcLookup_and_Reference
    mcDatabase
    mcText
    mcLogical
    mcInformation
    mcCommands
    mcCustomizing
    mcMacro_Control
    mcDDE_External
    mcUser_Defined
    mcFirst_custom_category
    mcSecond_custom_category 'and so on
End Enum 'mc_Macro_Categories

Function sbTimeAdd(dt As Date, dh As Double, _
    vwh As Variant, _
    Optional vHolidays As Variant, _
    Optional dtBreakLimit As Date, _
    Optional dtBreakDuration As Date) As Date
'Returns end date from start date dt and positive duration
'dh in hours (and minutes and seconds) but counts only
'time as given in table vwh: for example
'09:00   17:00  'Monday
'09:00   17:00  'Tuesday
'09:00   17:00  'Wednesday
'09:00   17:00  'Thursday
'09:00   17:00  'Friday
'00:00   00:00  'Saturday
'00:00   00:00  'Sunday
'00:00   00:00  'Holidays
'This table defines hours to count for each day of the
'week (starting with Monday, 2 columns) and for holidays.
'You can also define a break limit and a break duration.
'If the working hour for a day is exceeding the limit
'then the duration will be subtracted from its time.
'Source (EN): http://www.sulprobil.com/sbtimeadd_en/
'(C) (P) by Bernd Plumhoff 02-Feb-2019 PB V0.7
Dim dt1 As Date, dt2 As Date
Dim ldt1 As Long, lWDi As Long, v As Variant
Dim objHolidays As Object, objBreaks As Object

If dh < 0# Then
    sbTimeAdd = CVErr(xlErrValue)
    Exit Function
End If
If Not IsMissing(vHolidays) Then
    Set objHolidays = CreateObject("Scripting.Dictionary")
    For Each v In vHolidays
        objHolidays(Int(v.Value)) = 1
    Next v
End If
ldt1 = Int(dt)
lWDi = Weekday(ldt1, vbMonday)
If Not IsMissing(vHolidays) Then
    If objHolidays(ldt1) Then
        lWDi = 8
    End If
End If
dt1 = ldt1 + CDate(vwh(lWDi, 1)) 'start time of this day
If dt1 < dt Then dt1 = dt
dt2 = ldt1 + CDate(vwh(lWDi, 2)) 'end time of this day
If dt2 < dt1 Then dt2 = dt1
Do While Round2Sec(dt1 + dh - (dh >= dtBreakLimit) * _
    dtBreakDuration) > Round2Sec(dt2)
    'go ahead as long as our duration exceeds this day
    If dt1 < ldt1 + CDate(vwh(lWDi, 2)) Then
        dh = dh - dt2 + dt1 - (dh >= dtBreakLimit) * dtBreakDuration
    End If
    ldt1 = ldt1 + 1
    lWDi = Weekday(ldt1, vbMonday)
    If Not IsMissing(vHolidays) Then
        If objHolidays(ldt1) Then
            lWDi = 8
        End If
    End If
    dt1 = ldt1 + CDate(vwh(lWDi, 1)) 'start time of this day
    dt2 = ldt1 + CDate(vwh(lWDi, 2)) 'end time of this day
Loop
sbTimeAdd = dt1 + dh - (dh >= dtBreakLimit) * dtBreakDuration
End Function

Function Round2Sec(dt As Date) As Date
Round2Sec = Int(0.5 + dt * 24 * 60 * 60) / 24 / 60 / 60
End Function

Sub DescribeFunction_sbTimeAdd()

'Run this only once, then you will see this description in the function menu

Dim FuncName As String
Dim FuncDesc As String
Dim Category As String
Dim ArgDesc(1 To 6) As String

FuncName = "sbTimeAdd"
FuncDesc = "Add positive hours to a timepoint but count only time as specified for week days" & _
           " and for holidays increased by break time if working time exceeds specified time"
Category = mcDate_and_Time
ArgDesc(1) = "Start date and time where to count from"
ArgDesc(2) = "Hours to add"
ArgDesc(3) = "Range or array which defines which time to count during the week starting from Monday, " & _
            "8 by 2 matrix defining start time and end time for each weekday (8th row for holidays)"
ArgDesc(4) = "Optional list of holidays which overrule week days, define time to count in 8th row of vwh"
ArgDesc(5) = "Optional. Daily working time limit. If exceeded dtBreakDUration will be subtracted from total time"
ArgDesc(6) = "Optional. Break time. Will be subtracted from total time if daily working time exceeds dtBreakLimit"

Application.MacroOptions _
    Macro:=FuncName, _
    Description:=FuncDesc, _
    Category:=Category, _
    ArgumentDescriptions:=ArgDesc

End Sub

Download

Bitte den Haftungsausschluss im Impressum beachten.

sbTimeAdd.xlsm [36 KB Excel Datei, ohne jegliche Gewährleistung]