Listes déroulantes filtrées
au faite désolé, je n'ai pas répondu à ta question, un J est une journée ordinaire, travail de 7h45 à 16h45 ;)
bonne journée et encore merci
Bonjour à tous,
On a fait une liste déroulante pour ajouter des noms :
sFormula = sFormula & IIf(sFormula = "", "", ",") & Cells(x + (y * 2), 1avec un signe & pour +, mais maintenant...
si je le mets comme remplaçant un jour de nuit, le lendemain je peux quand même le sélectionner pour un remplacement de matin
il faudrait pouvoir enlever des noms et je m'en remets à Curulis pour connaitre le signe.
Je vous vois poster des doubles messages ici, sachez que vous pouvez modifier un message tant qu'il n'y a pas de réponses.
Brice, un bouton de RAZ, ok si tu as sauvegardé les remplacements avant dans un fichier.
dans la macro comment nomme t-on une ligne ?
Donnes un exemple ou mets le détail de ta macro.
Cdt
Salut les gars,
avec la "daye" que je me suis ramassé ces jours-ci, sans être sûr que ce n'était pas le Covid étant donné que mes 4 jeunes viennent de le faire ces dernières semaines, je suis encore dans le brouillard !
Un peu de patience, siouplaît...
A+
salut curulis,
repose toi bien et encore merci pour ton aide !
salut fronck,
je suis sur mon ordinateur et je n'ai que excel 2007 ... cane rends pas pareil que sur mon ordinateur du boulot...
il est temps que j'investisse dans un ordinateur et dans une nouvelle version d'excel, si là-dessus vous avez aussi un conseil à donner je suis preneur !
bonne journée à vous .
je vous envoie ça dès que je suis sur mon ordinateur.
Salut Brice,
perso, je n'achète mes portables qu'en ligne et seconde main avec garantie.
Quant à Office, sur Amazon, toujours à +- 20€.
En tout, un i5 15" + Windows 10 + Office 2019 = - de 300€.
Qui dit mieux ?
A+
Cool, je vais regarder ça de près ;)
Merci beaucoup !
Pas mal Curulis, moi j'ai un ASUS core i5 15.6" 4go ram depuis 5 ans, acheté neuf 545€ boosté en 2018 avec 8go ram 80€, et rajout récent d'un disque SSD 165€.
Et bon rétablissement.
Salut les gars,
il doit manquer des conditions. Ex : quid si le remplaçant fait "J" le lendemain ? Il peut faire "N" ? M'étonnerait...
Brice, tu peux peaufiner tes conditions ?
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
Dim iRow%, iCol%, iColWk%, iNb%, iNb1%, iNb2%, iNbDay%, iNbAbs%, iNbEnd%, iNbEq%, iNbWk%, iOK%
Dim sAgt$, sEq$, sFormula$, sPr$, sPv$, sPl$
'
If Selection.Columns.Count > 1 Or Selection.Row = 1 Then Exit Sub
'
iRow = Target.Row
iCol = Target.Column
iNb1 = Columns(1).Find(what:="Equipe 1", lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext).Row 'ligne Equipe 1
iNb2 = Columns(1).Find(what:="Equipe 2", lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext).Row 'ligne Equipe 2
iNbAbs = Columns(1).Find(what:="Absence", lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext).Row 'ligne Absence (Equipe 1)
iNbEnd = Columns(1).Find(what:="Equipe", lookat:=xlPart, LookIn:=xlValues, searchdirection:=xlPrevious).Row 'ligne dernière équipe
iNbEq = CInt(Split(Range("A" & iNbEnd).Value, " ")(1)) 'nbre d'équipes
iNbWk = (iNbAbs - (iNb1 + 2)) / 2 'nbre de travailleurs par équipe
iNb = iNb2 - iNb1 'nbre de lignes (libres comprises) occupées par une équipe
'
Cells.Validation.Delete
If Target.Offset(-1, 0) = "ABS" Then
iTRow = Range("A1:A" & iRow).Find(what:="Equipe", lookat:=xlPart, LookIn:=xlValues, searchdirection:=xlPrevious).Row 'ligne de l'équipe en cours
sEq = Range("A" & iTRow).Value 'nom de l'équipe en cours
'sPr = pause à remplacer - sPv = pause de la veille du candidat - sPl = pause du lendemain du candidat
sPr = Cells(iTRow + 1, iCol) 'Pause à remplacer
iColWk = WorksheetFunction.Max(2, iCol - 11) 'Jour - 11 : sert au calcul des 11 jours de travail MAX avant REPOS
For x = iNb1 To iNbEnd Step iNb
If Cells(x, 1) <> sEq And (Cells(x + 1, iCol) = "J" Or Cells(x + 1, iCol) = "REPOS") Then
For y = 1 To iNbWk
sAgt = Cells(x + (y * 2), 1) 'nom de l'agent
'condition de départ : existant - pas ABS - pas déjà remplaçant ce jour
If Not (IsNumeric(Cells(x + (y * 2), 1))) And Cells(x + (y * 2), iCol) <> "ABS" And WorksheetFunction.CountIf(Columns(iCol), sAgt) = 0 Then
iNbDay = iCol - iColWk 'nbre max de jours de travail les 11 jours précédents
For Z = iCol - 1 To iColWk Step -1 'soustrait les jours de REPOS sans remplacement ou jours ABS
If (Cells(x + 1, Z) = "REPOS" And WorksheetFunction.CountIf(Columns(Z), sAgt) = 0) Or _
Cells(x + (y * 2), Z) = "ABS" Then _
iNbDay = (iCol - 1) - Z: _
Exit For
Next
'si moins de 11 jours de travail avant ce jour
If iNbDay < 11 Then
sFlag = ""
For Z = -1 To 1 Step 2 'calcule les pauses de la veille (sPv) et du lendemain (sPl) du candidat
If iCol + Z > 1 Then
sFlag = IIf(Cells(x + 1, iCol + Z) = "REPOS" Or Cells(x + (y * 2), iCol + Z) = "ABS", "", Cells(x + 1, iCol + Z))
If WorksheetFunction.CountIf(Columns(iCol + Z), sAgt) > 0 Then _
iTRow = Range("A1:A" & x + (y * 2)).Find(what:="Equipe", lookat:=xlPart, LookIn:=xlValues, searchdirection:=xlPrevious).Row: _
sFlag = Cells(iTRow + 1, iCol + Z)
End If
If x = -1 Then sPv = sFlag Else sPl = sFlag
Next
iOK = 0
If sPr = "M" And (sPv = "N" Or sPv = "AM") Then iOK = 1
If (sPr = "M" Or sPr = "AM") And sPv = "N" Then iOK = 1
If sPr = "N" And (sPl = "M" Or sPl = "AM") Then iOK = 1
If sPr = "AM" And sPl = "M" Then iOK = 1
If iOK = 0 Then sFormula = sFormula & IIf(sFormula = "", "", ",") & sAgt
End If
End If
Next
End If
Next
If sFormula <> "" Then Target.Validation.Add Type:=xlValidateList, Formula1:=sFormula
End If
'
End Sub
A+
Salut Curulis,
J'ai essayé sur ton fichier en mettant DE PINHO en AM le 26/07 en équipe 4, et le matin du 27/07 en équipe6 il est dans la liste alors qu'il devrait pas...désolé.
De mon côté, je suis pas arrivé à associer les titulaires et remplaçants, et çà me parait difficile.
Brice, Moi je préconise de revenir à une situation simple, sans équipe. Les employés d'un coté les dates de l'autre, des périodes travaillées au milieu avec des listes déroulantes pour les modifier pour les remplaçants.
Tu peux mettre des formules en NB.SI pour calculer le nombre d'employés par période de travail.
La succession des périodes de travail est plus lisible et on peut mettre des msgbox sur une mauvaise sélection.
Cà donnerait çà, avec les lignes d'équipe amenées à disparaitre :
A plus
Salut les gars,
ah, oui, tu as tout à fait raison, Fronck !
Comme quoi, le brouillard n'est pas encore levé !
Pas de panique, je mets les anti-brouillard...
A+
Salut les gars,
correction faite : merci, Fronck, pour ta vigilance.
Dans cette version, j'étire la colonne de la demande pour une liste de validation dans laquelle j'ajoute à côté des candidats la suite des pauses.
Candidat/Pause de la veille - Pause à remplacer - Pause du lendemain
Ainsi, d'un coup d'oeil, on peut remarquer une anomalie.
J'ai ajouté comme condition de rejet : une Nuit avant un "J"
'si moins de 11 jours de travail avant ce jour
If iNbDay < 11 Then
For Z = -1 To 1 Step 2 'calcule les pauses de la veille (sPv) et du lendemain (sPl) du candidat
sFlag = ""
If iCol + Z > 1 Then
sFlag = IIf(Cells(x + (y * 2), iCol + Z) = "ABS", "A", IIf(Cells(x + 1, iCol + Z) = "REPOS", "R", Cells(x + 1, iCol + Z)))
If WorksheetFunction.CountIf(Columns(iCol + Z), sAgt) > 0 Then _
iRow = Columns(iCol + Z).Find(what:=sAgt, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext).Row: _
iTRow = Range("A1:A" & iRow).Find(what:="Equipe", lookat:=xlPart, LookIn:=xlValues, searchdirection:=xlPrevious).Row: _
sFlag = IIf(Cells(iTRow + 1, iCol + Z) = "REPOS", "R", Cells(iTRow + 1, iCol + Z))
End If
If Z = -1 Then sPv = sFlag Else sPl = sFlag
Next
iOK = 0
If sPr = "M" And (sPv = "N" Or sPv = "AM") Then iOK = 1
If (sPr = "M" Or sPr = "AM") And sPv = "N" Then iOK = 1
If sPr = "N" And (sPl = "M" Or sPl = "AM" Or sPl = "J") Then iOK = 1
If sPr = "AM" And sPl = "M" Then iOK = 1
If iOK = 0 Then sFormula = sFormula & IIf(sFormula = "", "", ",") & sAgt & "/" & sPv & "-" & sPr & "-" & sPl
End IfÀ tester, bien sûr.
A+
WAHOU,
salut Curulis et Fronck,
c'est génial !
je n'ai pas eu le temps de tout tester encore, malheureusement...
mais pour ce que j'en ai vu ça me parait pas mal, je vais essayé de l'approcher de sa forme finale:
- en faisant les mises en forme conditionnelle par VBA
- en le passant à 9 personnes par équipe (prévisionnelle)
- en essayant d’améliorer mon tableau récapitulatif des remplacements, en comptant le nombre de M, AM, N par personnes
- en réalisant un bouton RAZ pour les dates de vacances
- en créant un bouton imprimer, qui imprimerai le planning entre 2 dates choisi
- et pour finir j'aimerai arriver que le remplacement s'affiche dans la ligne de son planning d'origine.
- ex : si le 22 juillet Ettazi est remplacé par gauche, sur la ligne de gauche un N apparaisse .
c'est ambitieux comme projet je pense.
et le top serai d'avoir un bouton qui génère les remplacements tous seul
iOK = 0
If sPr = "M" And (sPv = "N" Or sPv = "AM") Then iOK = 1
If (sPr = "M" Or sPr = "AM") And sPv = "N" Then iOK = 1
If sPr = "N" And (sPl = "M" Or sPl = "AM" Or sPl = "J") Then iOK = 1
If sPr = "AM" And sPl = "M" Then iOK = 1
If iOK = 0 Then sFormula = sFormula & IIf(sFormula = "", "", ",") & sAgt & "/" & sPv & "-" & sPr & "-" & sPljuste un truc curulis dans la version actuelle, tu as rajouté comme condition de rejet : une Nuit avant un "J"
pour lever cette condition, il suffit d'effacer cette partie ?
Or sPl = "J"encore merci pour le temps passé dessus !!!
au travail j'ai trouvé ceci, quelqu'un apparemment avait déjà travaillé sur un planning, je n'arrive pas à le faire fonctionner, il plante en permanence, il y a surement des truc à récupérer.
bonne soirée.
Salut Brice Curulis,
C'est du beau boulot Curulis. Bonne idée de mettre l'info pour choisir la personne, çà agrandit et permet de marquer la colonne, et de l'enlever aprés, balaise.
Bonne idée Brice d'afficher la période de travail (la pause pour Curulis
Bon c'est Brice qui s'occupe des bugs alors
Et toutes ces formules dans les cellules vides, elles servent à quoi ?
Bon je vais regarder le code de curulis.
A+
Salut les gars,
- lever la condition de rejet N->J = OK ;
- afficher la pause de remplacement sur la ligne de l'agent concerné = OK ;
If InStr(Target, "/") > 0 And InStr(Target, "-") > 0 Then
iCol1 = Target.Column
sAgt = Split(Target, "/")(0)
Target = sAgt
If [AGENT] <> "" Then Call EffacerCopieChgt([AGENT], iCol1)
iRow = Range("A1:A" & Target.Row).Find(what:="Equipe", lookat:=xlPart, LookIn:=xlValues, searchdirection:=xlPrevious).Row
Cells(Columns(1).Find(what:=sAgt, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext).Row, iCol1) = Cells(iRow + 1, iCol1)
Columns.ColumnWidth = 8
[AGENT] = "": _
Target.Offset(-1, 0).Select
End If- ... plus l'effacer si changement de remplaçant ou annulation de remplacement il y a, bien sûr = OK ;
* pour les besoins de la cause, j'ai créé une cellule nommée en [A1], justement nommée [AGENT].
* t'ai-je dit que d'un clic-droit sur un remplaçant, tu effaces le remplacement ?
- élargissement des équipes à 9 agents prévisionnels = OK
A+
Re les gars,
Je viens juste de digérer le 1er code de la soirée.
Magnifique, j'ai appris des trucs, mais juste une remarque , on peut faire 2 end if aprés 2 if ?
Salut Fronck,
depuis lors, tu as trouvé la réponse, je présume ?
A+
Salut Curulis,
Non pas plus. J'ai aussi des questions sur les derniers codes:
Concernant la différence entre :
Private Sub Worksheet_SelectionChange(ByVal Target As Range) et
Private Sub Worksheet_Change(ByVal Target As Range)
- J'ai répondu à un post sur un changement dans les cellules d'une feuille par rapport à une liste déroulante. Avec SelectionChange il fallait cliquer n'importe ou dans une cellule aprés la liste déroulante et en changeant avec Change, çà fonctionnait juste avec le changement de choix dans la liste déroulante.
Moi j'aurais dit l'inverse. Et par rapport à tes 2 choix çà ne m'éclaire pas plus.
- pour [AGENT] c'est quoi cette bète ?
Target = sAgt
If [AGENT] <> "" Then Call EffacerCopieChgt([AGENT], iCol1)
iRow = Range("A1:A" & Target.Row).Find(what:="Equipe", lookat:=xlPart, LookIn:=xlValues, searchdirection:=xlPrevious).Row
Cells(Columns(1).Find(what:=sAgt, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext).Row, iCol1) = Cells(iRow + 1, iCol1)
Columns.ColumnWidth = 8
[AGENT] = "": _
Target.Offset(-1, 0).Select
Public Sub EffacerCopieChgt(ByVal sAgt$, iCol%)
Cells(Columns(1).Find(what:=sAgt, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext).Row, iCol) = ""
End SubA+
Salut Fronck,
pour tes 2 END IF, ben, non, on ne peut pas.
C'était juste un problème d'indentation du code que tu as montré
If Not (IsNumeric(Cells(x + (y * 2), 1))) And Cells(x + (y * 2), iCol) <> "ABS" And WorksheetFunction.CountIf(Columns(iCol), sAgt) = 0 Then
iNbDay = iCol - iColWk 'nbre max de jours de travail les 11 jours précédents
For Z = iCol - 1 To iColWk Step -1 'soustrait les jours de REPOS sans remplacement ou jours ABS
If (Cells(x + 1, Z) = "REPOS" And WorksheetFunction.CountIf(Columns(Z), sAgt) = 0) Or _
Cells(x + (y * 2), Z) = "ABS" Then _
iNbDay = (iCol - 1) - Z: _
Exit For
Next
'si moins de 11 jours de travail avant ce jour
If iNbDay < 11 Then
For Z = -1 To 1 Step 2 'calcule les pauses de la veille (sPv) et du lendemain (sPl) du candidat
sFlag = ""
If iCol + Z > 1 Then
sFlag = IIf(Cells(x + (y * 2), iCol + Z) = "ABS", "A", IIf(Cells(x + 1, iCol + Z) = "REPOS", "R", Cells(x + 1, iCol + Z)))
If WorksheetFunction.CountIf(Columns(iCol + Z), sAgt) > 0 Then _
iRow = Columns(iCol + Z).Find(what:=sAgt, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext).Row: _
iTRow = Range("A1:A" & iRow).Find(what:="Equipe", lookat:=xlPart, LookIn:=xlValues, searchdirection:=xlPrevious).Row: _
sFlag = IIf(Cells(iTRow + 1, iCol + Z) = "REPOS", "R", Cells(iTRow + 1, iCol + Z))
End If
If Z = -1 Then sPv = sFlag Else sPl = sFlag
Next
iOK = 0
If sPr = "M" And (sPv = "N" Or sPv = "AM") Then iOK = 1
If (sPr = "M" Or sPr = "AM") And sPv = "N" Then iOK = 1
If sPr = "N" And (sPl = "M" Or sPl = "AM") Then iOK = 1
If sPr = "AM" And sPl = "M" Then iOK = 1
If iOK = 0 Then sFormula = sFormula & IIf(sFormula = "", "", ",") & sAgt & "/" & sPv & "-" & sPr & "-" & sPl
End If
End IfComprends pas trop le fil de ta pensée pour la suite mais je vais commenter le code que tu as posté.
A+
Fronck,
pour ce qui est de [AGENT], il ne s'agit que d'une cellule nommée et de ma façon de l'écrire dans le code, plutôt que Range("A1").value.
Il semblerait que ce ne soit pas l'idéal de l'écrire ainsi, l'écriture entre crochets ayant une signification précise mais, perso, le code est 'achement plus facile à relire et comprendre ainsi.
Quand je clique sous une cellule "ABS" en vue d'un remplacement, il se peut que cette cellule soit déjà occupée par un remplaçant que l'on veut modifier ou supprimer.
Donc, dans 'SUB Worksheet_Selection_Change', je note le nom de ce remplaçant dans [AGENT] en vue de pouvoir effacer ce remplacement sur sa ligne propre.
La suite se passe dans 'SUB Worksheet_Change' si le remplacement a bien lieu.
Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim iRow%, iCol1%, sAgt$
'
Application.EnableEvents = False
Application.ScreenUpdating = False
'
If InStr(Target, "/") > 0 And InStr(Target, "-") > 0 Then
iCol1 = Target.Column
sAgt = Split(Target, "/")(0) 'nom de l'agent sans les valeurs sPv-sPr-sPl
Target = sAgt 'affichage du remplaçant
'si cellule [A1] (cellule nommée [AGENT]) est non-vide, effacer le remplacement du remplaçant précédent sur sa ligne
If [AGENT] <> "" Then Call EffacerCopieChgt([AGENT], iCol1)
'recherche de la pause de l'équipe appelante via sa ligne-équipe
iRow = Range("A1:A" & Target.Row).Find(what:="Equipe", lookat:=xlPart, LookIn:=xlValues, searchdirection:=xlPrevious).Row
'recherche de la ligne du remplaçant dans son équipe propre pour afficher la pause-remplacement
Cells(Columns(1).Find(what:=sAgt, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext).Row, iCol1) = Cells(iRow + 1, iCol1)
Columns.ColumnWidth = 8 'largeur originale de la colonne une fois le remplacement effectué
[AGENT] = "" 'la correction étant faite pour l'ancien remplaçant, la référence est effacée
Target.Offset(-1, 0).Select
End If
'
Application.ScreenUpdating = True
Application.EnableEvents = True
'
End Sub
A+
Petit raccourci pour trouver le libellé du remplacement dans la SUB ci-dessus.
Plutôt que de cherche la ligne iRow de l'équipe appelante, je splitte le nom brut de l'agent ( NOM/sPv-sPr-sPl ) puisque l'info s'y trouve déjà!
sPr = Split(Split(Target, "/")(1), "-")(1)Mieux...
A+