Einddatum+Tijd berekenen voor een specifieke werkkalender

[Piet Bom]

Voor mijn project: "Planning in Excel" ben ik op zoek naar een VBA-function die de Einddatum en tijd berekend.
Uitgaande van een Startdatum+Tijd, de doorlooptijd en het werktijdenschema.

Eerder heb ik al een andere VBA-function bekomen via dit forum van Sylvester Ponte en toen ging het om het berekenen van de effectieve werktijd tussen 2 datums ook volgens een werktijdenschema.
Zijn code is heel compact en werkt snel.

Function testTijd2(Van As Date, Tot As Date, Tabel As Range) As Date
    Dim Kolom, Rij, D, Van2 As Date, Tot2 As Date
    D = Van: GoSub bereken_dag 'eerste dag
    If int(van)<>int(tot) then D = Tot: GoSub bereken_dag 'laatste dag
    For D = Int(Van) + 1 To Int(Tot) - 1 'de hele tussen dagen direct uit tabel halen
        Kolom = DatePart("w", D, vbMonday)
        testTijd2 = testTijd2 + Tabel(0, Kolom) 'hier staat in het voorbeeldbestand de totale dag_tijd
    Next
Exit Function
bereken_dag:
With WorksheetFunction
    Kolom = DatePart("w", D, vbMonday)
    For Rij = 1 To Tabel.Rows.Count Step 2
        Van2 = Tabel(Rij, Kolom) + Int(D)
        Tot2 = Tabel(Rij + 1, Kolom) + Int(D)
        testTijd2 = testTijd2 + .Max(0, .Min(Tot, Tot2) - .Max(Van, Van2))
    Next
End With
Return
End Function

https://www.helpmij.nl/forum/showthread.php/941592-tijd-berekenen-op-basis-van-huidige-tijd-dag-van-de-week

Naar zijn code kijkend, dacht ik dat het niet moeilijk moest zijn om zo'n UDF te maken, maar mijn code wordt maar langer en langer en hij werkt nog niet helemaal goed.
Graag jullie hulp om een duwtje in de goede richting te krijgen.

 

[Piet Bom]

Mijn vraag is 113 keer bekeken en de bijlage 10 keer, maar nog geen reactie.
Heb ik te veel informatie gegeven of is de vraag niet duidelijk ?
Of overtreed ik misschien een forumregel ?

 

[alphamax]

Wat betekent 1a,1b,2a,2b,3a,3b,4a,4b in relatie tot de even en oneven weken.
Is het even1, oneven1, even2, oneven2, even3, oneven3, even4, oneven4 en dan weer van voor af aan.
Welke week van het jaar start even1?
Je tabel heeft uitleg nodig.

 

[Piet Bom]

Hoi alphamax.
Fijn dat je reageert.
De 1a,1b, etc hebben weinig betekenis.

Het rechts schema is voor oneven weken.
Per weekdag ma t/m zo heb je 4 werkblokken met daartussen 3 pauzes.
Ieder blok heeft een van-tijd en een tot-tijd.
Dus per werkdag kun je afwijkende werktijdblokken hebben.
Meestal zijn de ma-vr 5 keer hetzelfde en zaterdagen hebben dan mogelijk afwijkende werkblokken.
Links-boven staat een kalendercode: van wp_A t/m wp_Z dus het systeem voorziet in 26 verschillende werkpatronen
In een planning moet het mogelijk zijn om activiteiten door verschillende personen te laten uitvoeren die dan mogelijk op verschillende
werkpatronen werken.
Als een kalender geen verschil maakt tussen Oneven en Even weken, dan maak je het rechtse schema gelijk aan het linkse.
Op regel 2 staan de totale werkuren per dag (berekend via formule) en rechts staat het totaal aantal werkuren per week.
Als een kalender gewoon uit 1 blok bestaat en geen rekening houd met pauzes, vult je alleen het bovenste blok in:
bijv. Van 08:00 Tot 16:00, en de andere 3 blokken laat je leeg.
Is dit voldoende toegelicht ?

 

[alphamax]

[SIZE=1]Public Function EindDatumTijd(OnEvenSchema, EvenSchema, BeginDatumTijd, Duur)
    Do
        BeginDatum = Int(BeginDatumTijd)
        BeginDag = DatePart("w", BeginDatumTijd, 2)
        Schema = IIf(-(DatePart("ww", BeginDatumTijd - Weekday(BeginDatumTijd, 2) + 4, 2, 2)) Mod 2, OnEvenSchema, EvenSchema)
        For Blokken = 1 To UBound(Schema, 1) Step 2
            Van = BeginDatum + Schema(Blokken + 0, BeginDag)
            Tot = BeginDatum + Schema(Blokken + 1, BeginDag)
            If BeginDatumTijd < Tot Then
                If BeginDatumTijd < Van Then
                    Verschil = Tot - Van
                Else
                    Verschil = Tot - BeginDatumTijd
                End If
                If Duur - Verschil > 1 / 1440 Then
                    Duur = Duur - Verschil
                Else
                    Exit Do
                End If
            End If
        Next
        BeginDatumTijd = Int(BeginDatumTijd) + 1
    Loop
    EindDatumTijd = Van + Duur
End Function[/SIZE]

Jouw verwachtingen in

D19:D28

kloppen niet.

 

[Piet Bom]

Bedankt alphamax,
Dat is een mooie code. Lekker kort en overzichtelijk.
Ik zag wel een paar functies die ik nog moet bestuderen: IIf() en Mod 2
Ik ga jouw code toepassen op mijn data en zal hem proberen te doorgronden.
De reden van de verschillen zijn de feestdagen (Kerst en Nieuwjaar)
Ik was vergeten dat te melden (mea culpa). Als ik die feestdagen weglaat, kloppen jouw uitkomsten allemaal.
Ik ga zelf proberen de routine voor feestdagen in te voeren.
Ik ben momenteel erg druk met werken, maar komend weekend zal ik er verder naar kijken.
Als dat gaat lukken, ga ik daarna naar de volgende uitdaging:
Vanaf een einddatum-tijd via een doorlooptijd terugrekenen naar een startdatum-tijd.
Ik durf niet meer te zeggen dat dat niet moeilijk zal zijn, als ik vanuit jouw code vertrek.
Met die 3 funkties heb ik een goede basis voor mijn planning tool in Excel.