Beste Sylvester-ponte en Haije,
* Kwam er vrij laat achter dat er toch nog een klein probleempje huist
in de berekening van de macro.
Wanneer er nachtdiensten worden gedraaid en ik deze invoer gaat het
mis. Dus van vrijdag op zaterdag, zaterdag op zondag, etc.
Wat moet ik aan de macro toevoegen via ALT F11 om dit op te kunnen
lossen? Is dit mogelijk?
* Heb een aparte kolom die het aantal gewerkte uren berekent
van de gewerkte tijden. Een simpele soms als =E13-D13. Alleen met
nachtdiensten krijg ik hierbij #####. Om dit op te lossen wordt de som...?
Groetjes,
Remco
P.s.: kon niet toevoegen als bijlage. Het eerste blad is 300 kb en de
rest van de weken zo'n 1,5 mb. Geen idee waarom de eerste week
zo verschilt met de rest. Upload max. is 100 kb op dit forum.
De macro is:
* Kwam er vrij laat achter dat er toch nog een klein probleempje huist
in de berekening van de macro.
Wanneer er nachtdiensten worden gedraaid en ik deze invoer gaat het
mis. Dus van vrijdag op zaterdag, zaterdag op zondag, etc.
Wat moet ik aan de macro toevoegen via ALT F11 om dit op te kunnen
lossen? Is dit mogelijk?
* Heb een aparte kolom die het aantal gewerkte uren berekent
van de gewerkte tijden. Een simpele soms als =E13-D13. Alleen met
nachtdiensten krijg ik hierbij #####. Om dit op te lossen wordt de som...?
Groetjes,
Remco
P.s.: kon niet toevoegen als bijlage. Het eerste blad is 300 kb en de
rest van de weken zo'n 1,5 mb. Geen idee waarom de eerste week
zo verschilt met de rest. Upload max. is 100 kb op dit forum.
De macro is:
Code:
Function Procentjes(Cao As String, Nr As Integer)
Dim R As Range
Procentjes = ""
Set R = Sheets("Bron").UsedRange.Columns(1).Find(Cao)
If Not R Is Nothing Then
If R.Offset(4, Nr) <> "" Then Procentjes = R.Offset(4, Nr)
End If
End Function
Code:
Function Gewerkt(Van As Date, Tot As Date, Dag, Percentage, Cao As String)
Dim R As Range, Ra As Range, Dagnaam As String
Gewerkt = 0
'zoek de Cao
Set R = Sheets("Bron").UsedRange.Columns(1).Find(Cao)
'als er geen Cao gevonden is dan stoppen
If R Is Nothing Then GoTo klaar
'set Dagnaam en als er geen Dagnaam is dan stoppen
Select Case Dag
Case "Maandag", "Dinsdag", "Woensdag", "Donderdag", "Vrijdag"
Dagnaam = "ma-vr"
Case "Zaterdag"
Dagnaam = "za"
Case "Zondag"
Dagnaam = "zo"
Case Else
GoTo klaar
End Select
'zoek de tabelkop en als deze niet gevonden wordt dan stoppen
Set R = R.Offset(0, 1)
Do
If R = Dagnaam And R.Offset(0, 1) = Percentage Then
Set R = R.Offset(1, 0).Resize(2, 2)
Exit Do
End If
Set R = R.Offset(0, 2)
If R = "" Then GoTo klaar
Loop
'tijden uit tijdentabel R vergelijken met tijd Van en tijd Tot
For Each Ra In R.Columns(1).Cells
If Ra <> "" Then Gewerkt = Gewerkt + Overlap(Van, Tot, Ra, Ra(1, 2))
Next Ra
klaar:
If Gewerkt = 0 Then Gewerkt = ""
End Function
Code:
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
Laatst bewerkt door een moderator:
