OVH Cloud OVH Cloud

repartition de postes suite

4 réponses
Avatar
Patrice C.
Bonsoir

Notre Excellentissime Vaudois m'a fourni une superbe macro pour la
répartition des postes en semaine
(fil : repartition de postes - Patrice C. - 30/03/04 18:42)
Mais j'ai d'autres contraintes que je règle manuellement pour l'instant
Serait il possible de les automatiser?
-1- les surveillants sont de service 1 week-end (les 2 jours) sur 8 et dans
ce cas il ne sont pas de service
la semaine avant et la semaine apres
-2- en cas de jour férié mardi , mercredi, jeudi, vendredi, le surveillant
de service ce jour, l'est également la veille par principe. Par contre cela
ne change pas la donne qui est que chacun sur une periode de 8 semaines est
de service
7 journées mais jamais 2 fois le meme jour (1 lundi, 1 mardi, etc...)
le WE est indissociable et il n'y a jamais 3 jours de service de suite
-3- Et si en plus, il etait possible de faire varier le nombre de
surveillants (en + ou en -) sans tout modifier ce serait super!!!!
J'espere que je suis clair....
Merci d'avance aux avis éclairés
Cordialement
Patrice C.





--
Cordialement
Patrice CASADEI

4 réponses

Avatar
Jean-François Aubert
Saut Patrice,
L'ego du Vaudois a été sensible aux flatteries ;-))))
En réalité, il est plutôt maso de se lancer dans des trucs pareils.

- Les plages sont en colonnes
- La plage des noms est nommée: lesNoms
- La plage des jours fériés est nommée: férié
- La plage des dates est nommée: lesDates (dans une colonne, commence en ligne 2)
- La colonne à droite et à gauche des dates doit être vide
- à gauche des dates, en ligne 2, la formule à tirer vers le bas:
=ENT((B2-SOMME(MOD(DATE(ANNEE(B2-MOD(B2-2;7)+3);1;2);{1E+99;7})*{1;-1})+5)/7)

'*******************************************
Sub yy2()
Dim c As Range, nb, i
Dim cell As Range
Dim tblW(), iW
Dim iTbl
Dim testTour
Dim y, z, cntC
ReDim Preserve tblW(53, 1)
iW = 0
[lesDates].Offset(0, 1).Clear
[lesDates].Interior.ColorIndex = xlNone
nb = [lesNoms].Count
If [COUNTIF(lesNoms,"*")] <= 2 Then _
MsgBox "le nombre de surveillants est trop petit": _
Exit Sub

'au cas où i = -1 ou i= 0
On Error Resume Next

For Each c In [lesDates]
'au cas où des cellules de la plage lesDates sont vides
' ou ne sont pas des dates valides
If Not IsDate(c) Then GoTo suite
If i = nb Then i = 0
' au cas où les dates comportent les samedi/dimanche
If Weekday(c, 2) < 6 Then GoTo suite
i = i + 1
' au cas où des cellules de la plage lesNoms sont vides
Do Until [lesNoms].Item(i) <> ""
i = i + 1
If i > nb Then i = 1 ' -1
Loop
c.Offset(0, 1) = [lesNoms].Item(i)
c.Interior.ColorIndex = 3
tblW(c.Offset(0, -1), 0) = c.Offset(0, -1)
tblW(c.Offset(0, -1), 1) = c.Offset(0, 1)
If Weekday(c, 2) > 6 Then iW = iW + 1
If Weekday(c.Offset(1, 0), 2) > 5 Then i = i - 1:

suite:
Next c
i = 0
'************************************************************

y = 1: z = [lesDates].Item([lesDates].Count).Address
suite5:
For Each c In Range([lesDates].Item(y).Address & ":" & z)
testTour = 0
cntC = cntC + 1
c.Select
'au cas où des cellules de la plage lesDates sont vides
' ou ne sont pas des dates valides
If Not IsDate(c) Then GoTo suite
If i = nb Then i = 0
' au cas où les dates comportent les samedi/dimanche
If Weekday(c, 2) > 5 Then GoTo suite2
i = i + 1
' au cas où des cellules de la plage lesNoms sont vides
suite3:
Do Until [lesNoms].Item(i) <> ""
i = i + 1
testTour = testTour + 1
If i > nb Then i = 1
Loop

If Not IsNumeric(c.Offset(-1, -1) - 1) Then ' pour 1ère date
If [lesNoms].Item(i) = tblW(c.Offset(0, -1), 1) Then
i = i + 1
testTour = testTour + 1
c.Offset(0, 1) = [lesNoms].Item(i)
GoTo suite2
Else
c.Offset(0, 1) = [lesNoms].Item(i)
GoTo suite2
End If
End If


For Each cell In Range([lesDates].Item(y).Address & ":" & z)
If Weekday(cell, 2) < 6 Then
If [lesNoms].Item(i) = cell.Offset(0, 1) Then
If Weekday(cell, 2) = Weekday(c, 2) Then
i = i + 1
testTour = testTour + 1
If testTour = [lesNoms].Count Then
GoTo suite6
End If
GoTo suite3
End If
End If
End If
Next
suite4:
If [lesNoms].Item(i) = "" Then
GoTo suite3
Else
If [lesNoms].Item(i) = tblW(c.Offset(0, -1), 1) Or _
[lesNoms].Item(i) = tblW(c.Offset(0, -1) - 1, 1) Then
' si nom travaille déjà week avant ou après
i = i + 1
GoTo suite3
End If
End If
If c.Offset(-1, 1) = [lesNoms].Item(i) Then
' si nom 2 jours de suite
suite6:
y = cntC
cntC = 0
i = 0
GoTo suite5
Else
c.Offset(0, 1) = [lesNoms].Item(i)
End If
suite2:
Next c
'les jours férié
For Each c In [lesDates]
For Each cell In [férié]
c.Select
If c = cell And Weekday(c, 2) < 5 And Weekday(c, 2) > 1 Then
c.Interior.ColorIndex = 5
c.Offset(0, 1) = c.Offset(1, 1)
End If
Next
Next
End Sub

'********************************************


--
Amicalement

Jean-François Aubert
{Vaudois de la Côte Lémanique}


"Patrice C." a écrit dans le message de
news:
Bonsoir

Notre Excellentissime Vaudois m'a fourni une superbe macro pour la
répartition des postes en semaine
(fil : repartition de postes - Patrice C. - 30/03/04 18:42)
Mais j'ai d'autres contraintes que je règle manuellement pour l'instant
Serait il possible de les automatiser?
-1- les surveillants sont de service 1 week-end (les 2 jours) sur 8 et dans
ce cas il ne sont pas de service
la semaine avant et la semaine apres
-2- en cas de jour férié mardi , mercredi, jeudi, vendredi, le surveillant
de service ce jour, l'est également la veille par principe. Par contre cela
ne change pas la donne qui est que chacun sur une periode de 8 semaines est
de service
7 journées mais jamais 2 fois le meme jour (1 lundi, 1 mardi, etc...)
le WE est indissociable et il n'y a jamais 3 jours de service de suite
-3- Et si en plus, il etait possible de faire varier le nombre de
surveillants (en + ou en -) sans tout modifier ce serait super!!!!
J'espere que je suis clair....
Merci d'avance aux avis éclairés
Cordialement
Patrice C.





--
Cordialement
Patrice CASADEI




Avatar
Patrice C.
Merci pour ta gentillesse mais j'ai un probleme
la macro ne se termine pas (j'ai le sablier sur l'ecran et je suis bloqué)
et je suis obligé de faire Alt+control+del pour continuer...
D'autre part je vois que le meme nom se retrouve 2 fois la meme semaine ce
qui ne peut se faire
Peux tu m'expliquer pourquoi ça bloque
cordialement
PATRICE

"Jean-François Aubert" <à a écrit dans le message de
news:
Saut Patrice,
L'ego du Vaudois a été sensible aux flatteries ;-))))
En réalité, il est plutôt maso de se lancer dans des trucs pareils.

- Les plages sont en colonnes
- La plage des noms est nommée: lesNoms
- La plage des jours fériés est nommée: férié
- La plage des dates est nommée: lesDates (dans une colonne, commence en
ligne 2)

- La colonne à droite et à gauche des dates doit être vide
- à gauche des dates, en ligne 2, la formule à tirer vers le bas:

=ENT((B2-SOMME(MOD(DATE(ANNEE(B2-MOD(B2-2;7)+3);1;2);{1E+99;7})*{1;-1})+5)/7

)

'*******************************************
Sub yy2()
Dim c As Range, nb, i
Dim cell As Range
Dim tblW(), iW
Dim iTbl
Dim testTour
Dim y, z, cntC
ReDim Preserve tblW(53, 1)
iW = 0
[lesDates].Offset(0, 1).Clear
[lesDates].Interior.ColorIndex = xlNone
nb = [lesNoms].Count
If [COUNTIF(lesNoms,"*")] <= 2 Then _
MsgBox "le nombre de surveillants est trop petit": _
Exit Sub

'au cas où i = -1 ou i= 0
On Error Resume Next

For Each c In [lesDates]
'au cas où des cellules de la plage lesDates sont vides
' ou ne sont pas des dates valides
If Not IsDate(c) Then GoTo suite
If i = nb Then i = 0
' au cas où les dates comportent les samedi/dimanche
If Weekday(c, 2) < 6 Then GoTo suite
i = i + 1
' au cas où des cellules de la plage lesNoms sont vides
Do Until [lesNoms].Item(i) <> ""
i = i + 1
If i > nb Then i = 1 ' -1
Loop
c.Offset(0, 1) = [lesNoms].Item(i)
c.Interior.ColorIndex = 3
tblW(c.Offset(0, -1), 0) = c.Offset(0, -1)
tblW(c.Offset(0, -1), 1) = c.Offset(0, 1)
If Weekday(c, 2) > 6 Then iW = iW + 1
If Weekday(c.Offset(1, 0), 2) > 5 Then i = i - 1:

suite:
Next c
i = 0
'************************************************************

y = 1: z = [lesDates].Item([lesDates].Count).Address
suite5:
For Each c In Range([lesDates].Item(y).Address & ":" & z)
testTour = 0
cntC = cntC + 1
c.Select
'au cas où des cellules de la plage lesDates sont vides
' ou ne sont pas des dates valides
If Not IsDate(c) Then GoTo suite
If i = nb Then i = 0
' au cas où les dates comportent les samedi/dimanche
If Weekday(c, 2) > 5 Then GoTo suite2
i = i + 1
' au cas où des cellules de la plage lesNoms sont vides
suite3:
Do Until [lesNoms].Item(i) <> ""
i = i + 1
testTour = testTour + 1
If i > nb Then i = 1
Loop

If Not IsNumeric(c.Offset(-1, -1) - 1) Then ' pour 1ère date
If [lesNoms].Item(i) = tblW(c.Offset(0, -1), 1) Then
i = i + 1
testTour = testTour + 1
c.Offset(0, 1) = [lesNoms].Item(i)
GoTo suite2
Else
c.Offset(0, 1) = [lesNoms].Item(i)
GoTo suite2
End If
End If


For Each cell In Range([lesDates].Item(y).Address & ":" & z)
If Weekday(cell, 2) < 6 Then
If [lesNoms].Item(i) = cell.Offset(0, 1) Then
If Weekday(cell, 2) = Weekday(c, 2) Then
i = i + 1
testTour = testTour + 1
If testTour = [lesNoms].Count Then
GoTo suite6
End If
GoTo suite3
End If
End If
End If
Next
suite4:
If [lesNoms].Item(i) = "" Then
GoTo suite3
Else
If [lesNoms].Item(i) = tblW(c.Offset(0, -1), 1) Or _
[lesNoms].Item(i) = tblW(c.Offset(0, -1) - 1, 1) Then
' si nom travaille déjà week avant ou après
i = i + 1
GoTo suite3
End If
End If
If c.Offset(-1, 1) = [lesNoms].Item(i) Then
' si nom 2 jours de suite
suite6:
y = cntC
cntC = 0
i = 0
GoTo suite5
Else
c.Offset(0, 1) = [lesNoms].Item(i)
End If
suite2:
Next c
'les jours férié
For Each c In [lesDates]
For Each cell In [férié]
c.Select
If c = cell And Weekday(c, 2) < 5 And Weekday(c, 2) > 1 Then
c.Interior.ColorIndex = 5
c.Offset(0, 1) = c.Offset(1, 1)
End If
Next
Next
End Sub

'********************************************


--
Amicalement

Jean-François Aubert
{Vaudois de la Côte Lémanique}


"Patrice C." a écrit dans le message
de

news:
Bonsoir

Notre Excellentissime Vaudois m'a fourni une superbe macro pour la
répartition des postes en semaine
(fil : repartition de postes - Patrice C. - 30/03/04 18:42)
Mais j'ai d'autres contraintes que je règle manuellement pour l'instant
Serait il possible de les automatiser?
-1- les surveillants sont de service 1 week-end (les 2 jours) sur 8 et
dans


ce cas il ne sont pas de service
la semaine avant et la semaine apres
-2- en cas de jour férié mardi , mercredi, jeudi, vendredi, le
surveillant


de service ce jour, l'est également la veille par principe. Par contre
cela


ne change pas la donne qui est que chacun sur une periode de 8 semaines
est


de service
7 journées mais jamais 2 fois le meme jour (1 lundi, 1 mardi, etc...)
le WE est indissociable et il n'y a jamais 3 jours de service de suite
-3- Et si en plus, il etait possible de faire varier le nombre de
surveillants (en + ou en -) sans tout modifier ce serait super!!!!
J'espere que je suis clair....
Merci d'avance aux avis éclairés
Cordialement
Patrice C.





--
Cordialement
Patrice CASADEI








Avatar
Jean-François Aubert
reponse en bal privée

--
Amicalement

Jean-François Aubert
{Vaudois de la Côte Lémanique}


"Patrice C." a écrit dans le message de
news:
Merci pour ta gentillesse mais j'ai un probleme
la macro ne se termine pas (j'ai le sablier sur l'ecran et je suis bloqué)
et je suis obligé de faire Alt+control+del pour continuer...
D'autre part je vois que le meme nom se retrouve 2 fois la meme semaine ce
qui ne peut se faire
Peux tu m'expliquer pourquoi ça bloque
cordialement
PATRICE



Avatar
Patrice C.
Merci beaucoup
J'y vais de ce pas
--
Cordialement
Patrice C
pour m'écrire enlever "spammeuroubliezmoi_"

"Jean-François Aubert" <à a écrit dans le message de
news:eV$
reponse en bal privée

--
Amicalement

Jean-François Aubert
{Vaudois de la Côte Lémanique}


"Patrice C." a écrit dans le message
de

news:
Merci pour ta gentillesse mais j'ai un probleme
la macro ne se termine pas (j'ai le sablier sur l'ecran et je suis
bloqué)


et je suis obligé de faire Alt+control+del pour continuer...
D'autre part je vois que le meme nom se retrouve 2 fois la meme semaine
ce


qui ne peut se faire
Peux tu m'expliquer pourquoi ça bloque
cordialement
PATRICE