Feestdagen in code verwerken

[wieter]

In bijgevoegd bestand zit de nieuwe code van Sylvester Ponte.
Dit scheelt een pak aan formules. En er kan over middernacht gewerkt worden.
Nu heb ik al uren geprobeerd, om de feestdagen(blad2) in die code te verwerken.

Met een extra voorwaarde probeer ik, in dit stukje van de code, de feestdagen aan 200% te krijgen.
Dit wil maar niet lukken.

    Dag = Weekday(Datum, 2)
    
    If Dag < 6 Then
        DagTekst = "m-vr"
    ElseIf Dag = 6 Then
        DagTekst = "za"
    Else
        DagTekst = "zo/feest"
    End If

Bekijk bijlage Urenreg. met ort (8).xlsm
Wie kan het wel?

 

[cow18]

dit had ik vroeger nog eens gebruikt, je kan het zo aanpassen

Function Uren(Datum, Begin, Einde, Wat)
  Dim u(1 To 4), d1 As Date, d2 As Date, dVan As Double, dTot As Double, Dag, Weekdag%, b, e, bFeestdag As Boolean
  Application.Volatile
  'b = TimeValue(Replace(Begin, ".", ":")): e = TimeValue(Replace(Einde, ".", ":"))
  If IsEmpty(Datum) Or IsEmpty(Begin) Or IsEmpty(Einde) Or IsEmpty(Wat) Then
  Else
    b = Begin: e = Einde
    d1 = Datum + b                                         'begintijdstip
    d2 = Datum + e - (b >= e)                               'eindtijdstip( indien beginuur groter is dan einduur, tel er dan een dag bij)
    Do                                                     'in een loop lopen van begintijdstip tot eindtijdstip en dat per dag
      dVan = d1 - Int(d1): dTot = IIf(Int(d1) = Int(d2), d2 - Int(d2), 1): Weekdag = Weekday(d1, 2)
      bFeestdag = IsNumeric(Application.Match(Int(CDbl(d1)), Range("MijnFeestdagen"), 0))
      If bFeestdag Then
        Select Case Wat
          Case "wettelijke feestdag": If WorksheetFunction.Median(1, 5, Weekdag) = Weekdag Then Uren = Uren + Overlap(dVan, dTot, TimeSerial(6, 0, 0), TimeSerial(22, 0, 0))  'DoorDeWeek Dag = Ma-Vr 06:00 tot 22:00
          Case "wettelijke feestdag nacht": If WorksheetFunction.Median(1, 5, Weekdag) = Weekdag Then Uren = Uren + Overlap(dVan, dTot, TimeSerial(0, 0, 0), TimeSerial(6, 0, 0)) + Overlap(dVan, dTot, TimeSerial(22, 0, 0), 1)  'behalve Vr 22:00 tot 00:00
          Case "wettelijke feestdag zaterdag": If Weekdag = 6 Then Uren = Uren + Overlap(dVan, dTot, TimeSerial(6, 0, 0), TimeSerial(22, 0, 0))  'DoorDeWeek Dag = Ma-Vr 06:00 tot 22:00
          Case "wettelijke feestdag zondag": If Weekdag = 7 Then Uren = Uren + Overlap(dVan, dTot, TimeSerial(6, 0, 0), TimeSerial(22, 0, 0))  'DoorDeWeek Dag = Ma-Vr 06:00 tot 22:00
          Case "wettelijke feestdag zaterdag nacht": If Weekdag = 6 Then Uren = Uren + Overlap(dVan, dTot, TimeSerial(0, 0, 0), TimeSerial(6, 0, 0)) + Overlap(dVan, dTot, TimeSerial(22, 0, 0), 1)  'behalve Vr 22:00 tot 00:00
          Case "wettelijke feestdag zondag nacht": If Weekdag = 7 Then Uren = Uren + Overlap(dVan, dTot, TimeSerial(0, 0, 0), TimeSerial(6, 0, 0)) + Overlap(dVan, dTot, TimeSerial(22, 0, 0), 1)  'behalve Vr 22:00 tot 00:00
        End Select
      Else
        Select Case Wat
          Case "dag": If WorksheetFunction.Median(1, 5, Weekdag) = Weekdag Then Uren = Uren + Overlap(dVan, dTot, TimeSerial(6, 0, 0), TimeSerial(22, 0, 0))  'DoorDeWeek Dag = Ma-Vr 06:00 tot 22:00
          Case "Nacht": If WorksheetFunction.Median(1, 5, Weekdag) = Weekdag Then Uren = Uren + Overlap(dVan, dTot, TimeSerial(0, 0, 0), TimeSerial(6, 0, 0)) + Overlap(dVan, dTot, TimeSerial(22, 0, 0), 1)  'behalve Vr 22:00 tot 00:00
          Case "zaterdag": If Weekdag = 6 Then Uren = Uren + Overlap(dVan, dTot, TimeSerial(6, 0, 0), TimeSerial(22, 0, 0))  'DoorDeWeek Dag = Ma-Vr 06:00 tot 22:00
          Case "zondag": If Weekdag = 7 Then Uren = Uren + Overlap(dVan, dTot, TimeSerial(6, 0, 0), TimeSerial(22, 0, 0))  'DoorDeWeek Dag = Ma-Vr 06:00 tot 22:00
          Case "zaterdag nacht": If Weekdag = 6 Then Uren = Uren + Overlap(dVan, dTot, TimeSerial(0, 0, 0), TimeSerial(6, 0, 0)) + Overlap(dVan, dTot, TimeSerial(22, 0, 0), 1)  'behalve Vr 22:00 tot 00:00
          Case "zondag nacht": If Weekdag = 7 Then Uren = Uren + Overlap(dVan, dTot, TimeSerial(0, 0, 0), TimeSerial(6, 0, 0)) + Overlap(dVan, dTot, TimeSerial(22, 0, 0), 1)  'behalve Vr 22:00 tot 00:00
        End Select
      End If
      d1 = Int(d1 + 1)
    Loop While d1 <= d2
  End If
  Uren = IIf(Uren < 0.000001, "", Uren * 24)
End Function

Function Overlap(Van1, Tot1, Van2, Tot2)
  Dim W1 As Boolean, W2 As Boolean, W3 As Boolean, W4 As Boolean, Temp
  If Van1 > Tot1 Then Temp = Van1: Van1 = Tot1: Tot1 = Temp
  If Van2 > Tot2 Then Temp = Van2: Van2 = Tot2: Tot2 = Temp
  W1 = Van1 < Van2
  W2 = (Van1 < Tot2) And Not W1
  W3 = Tot1 < Van2
  W4 = (Tot1 < Tot2) And Not W3
  Overlap = (Tot2 - Van2) * (W3 - W1) - (Tot2 - Van1) * W2 + (Tot2 - Tot1) * W4
End Function

 

[wieter]

Ik probeer nog altijd de feestdagen in de code te verwerken.
Als ik in onderstaande code, het rode stukje, vervang

Function WerkUren(Datum As Date, Procenten, Van, Tot, Tabel As Range)
    Dim DagTekst As String, Dag As Integer, R As Range, N As Integer, LaatsteKolomNr As Integer, feestdagen As Range
    If Van > Tot Then
        WerkUren = WerkUren(Datum, Procenten, Van, 1, Tabel) + WerkUren(Datum + 1, Procenten, 0, Tot, Tabel)
        Exit Function
    End If
    LaatsteKolomNr = Tabel.Column + Tabel.Columns.Count
    
[COLOR="#FF0000"]    'maak DagTekst
    Dag = Weekday(Datum, 2)
    
    If Dag < 6 Then
        DagTekst = "m-vr"
    ElseIf Dag = 6 Then
        DagTekst = "za"
    Else
        DagTekst = "zo/feest"
    End If
    [/COLOR]    
    'zet R op de overwerktabel regel
    For Each R In Tabel.Columns(1).Cells
        If R = Procenten And R(1, 2) = DagTekst Then
            Set R = R(1, 3)
            Exit For
        End If
    Next
    If R Is Nothing Then Exit Function
    If R.Column = Tabel.Column Then: Exit Function
    'R staat nu op het juiste punt in de overwerktabel
    
    'Overlap werktijden  met overwerktabel bepalen en optellen
    Do
        If R <> "" And R(1, 2) <> "" Then
            WerkUren = WerkUren + Overlap(Van, Tot, R, R(1, 2))
        End If
        Set R = R(1, 3)
    Loop Until R.Column >= LaatsteKolomNr
End Function

door dit stukje ( in range "AA" staat de weekdagnummer).
Bij een feestdag staat er een 7.

    'maak DagTekst
    For x = 3 To 33
    Dag = Sheets("Blad1").Range("AA" & x).Value
    If Dag < 6 Then
        DagTekst = "m-vr"
    ElseIf Dag = 6 Then
        DagTekst = "za"
    Else
        DagTekst = "zo/feest"
    End If
    Next

Dan is het resultaat niet juist.
Wie weet de oplossing?
Elsendoorn heeft me ondertussen een oplossing geboden
Bekijk bijlage Urenreg. met ort (8).xlsm