Voorwaarde aan code toevoegen

[wieter]

Deze vraag is ook op het Excelforum geplaatst, maar daar verwacht ik geen antwoord meer.
Misschien kunnen de VBA-experten hier, wel een oplossing bieden?
De extra voorwaarde die moet toegevoegd worden, staat rood aangegeven.

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
    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"] 'If (Datum, 2) voorkomt in de lijst van de feestdagen op Blad2A2:A13
    'Then Dag = 7
    'Else Dag = Weekday(Datum, 2)[/COLOR]    
    
    Dag = Weekday(Datum, 2)
    If Dag < 6 Then
        DagTekst = "m-vr"
    ElseIf Dag = 6 Then
        DagTekst = "za"
    Else
        DagTekst = "zo/feest"
    End If
    
    
    '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

Bekijk bijlage Urenreg. met ort (10).xlsm

 

[Elsendoorn2134]

Wieter,

Vervang de code door:

    Set C = Sheets("Blad2").Range("A2:A13").Find(What:=Datum, LookIn:=xlValues)
    If Not C Is Nothing Then
        Dag = 7
    Else
        Dag = Weekday(Datum, 2)
    End If

Veel Succes

 

[wieter]

Bedankt Elsendoorn,
Daar was ik nu al 4 dagen naar aan het zoeken.
Fijn dat je hebt willen helpen.

 

[wieter]

Ik heb de code van Elsendoorn toegepast in het bestand.
En nu gebeurt er iets raars in de maand februari (en alleen in februari).
Als ik de knop standaarduren gebruik, loopt het fout op 25 en 26 februari.
De werkuren worden berekend aan 200% (alsof het een zon- of feestdag is)

Heeft iemand de moed om dit uit te pluizen?

Bekijk bijlage Urenreg. met ort (2).xlsm

ps. Als je na het invullen van de standaarduren even van maand wisselt, herstelt de fout zich (raaaaar!)

 

[Elsendoorn2134]

Wieter,

Was even een leuke brainpuzzle maar ben er uit.
Het probleem was dat hij 25-12-2014 en 25-2-2014 niet uit elkaar kan houden (he??)
Wijzig de zoekregel als volgt dan heb je dit probleem niet meer.

Set c = Sheets("Blad2").Range("A2:A13").Find(What:=Datum, LookIn:=xlValues, LookAt:=xlWhole)

Veel Succes.

 

[wieter]

Knap van je Elsendoorn, dat je dat puzzelwerk toch maar wil doen!!
Ik was al uren aan het experimenteren met de celeigenschappen van de datums.
Met *25/2/2014 - probleem in februari
Zonder het sterretje - geen probleem in februari, maar dan weer probleem in andere maand.

Super bedankt om dit op te lossen!!