doorlopend rooster

[123biertje]

Heb deze code van VenA , daarvoor bedankt,
maar ik probeerde dit rooster doorlopend te maken naar het volgende jaar, maar dan moet ik de datum weer veranderen.
Is er ook een manier dat het rooster gewoon door loopt.


Bvd Henk

Code:
Function Ploeg(datum As Date, plg As String, referentiedatum As Date)
ar = Split("A E D C B")
rooster = Array("-", "-", "-", "-", "O", "O", "M", "M", "N", "N")
referentiedatum = referentiedatum + 2 * Application.Match(plg, ar, 0)
nummerinarray = DateDiff("d", referentiedatum, datum) Mod (UBound(rooster) + 1)
If nummerinarray < 0 Then nummerinarray = nummerinarray + UBound(rooster) + 1
Ploeg = rooster(nummerinarray)
End Function
De aanroep in D5 wordt dan
Code:
=Ploeg($C5;D$4;DATE(2019;12;2))

 

[HSV]

Zet de datum in een cel.

 

[pasan]

vul de start datums ochtendploeg zelf in
de functie is als volgt
=ploeg(datum;uurgetal) de datum is welke in de sheet staat, het uurgetal is of 7 of 15 of 23 respectievelijk ochtend, middag en nachtploeg

Public Function Dienst(h As Integer)
   naam = Array("Nacht", "Nacht", "Middag", "Ochtend")
   uur = Array(h < 7, h >= 23, h >= 15, h >= 7)
   For I = 0 To UBound(uur)
   If uur(I) Then Exit For
   Next
   Dienst = naam(I)

End Function


Public Function Ploeg(Datum As Date, h As Integer)

Dim Rooster() As Variant

u = Dienst(h)
Rooster = Array("Ochtend", "Ochtend", "Middag", "Middag", "Nacht", "Nacht", "", "", "", "")
L = Split("A,B,C,D,E", ",")
d = Array("02/12/2019", "?????", "????", "????", "????") 'eerste ochtend ploeg datum die begint op een maandag voor elke ploeg (de eerste is voor ploeg A enz)

 For I = 0 To UBound(L)
  ReferentieDatum = d(I)
   NummerinArray = DateDiff("d", ReferentieDatum, CDate(Datum)) Mod (UBound(Rooster) + 1)
   If NummerinArray < 0 Then NummerinArray = NummerinArray + UBound(Rooster) + 1
    pl = Rooster(NummerinArray)
     If u = pl Then Ploeg = L(I)
 Next

End Function