Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force.
Apprenez, échangez, progressez – et tout ça gratuitement !
👉 Inscrivez-vous maintenant !
Dans mon fichier excel, Dans la feuille "Horaire Viandes", ce trouve les horaires des employés. Dans la feuille "Remplacement", ce trouve chaque employés avec les préférence de remplacement.
Je voudrais que si une personne est indiqué comme en Vacance dans la feuille "Horaire Viandes" colonne S, qui regarde dans la feuille "Remplacement" en commençant par le premier nom de cette feuille, et assigne les heures de travail au plus vieux en ancienneté.
Exemple: Si Yves, le plus ancien, travail du Mardi au Vendredi à 5H00 mais là, il est en vacance et que Michel lui, est le 2ième en ancienneté, à ce choix, qu'il lui transfert son horaire automatiquement en cliquant sur un bouton VBA.
Private Sub CommandButton1_Click()
Dim Nom As Range, Trouve As Range, Remplace As Range
'pour chaque nom colonne A
For Each Nom In Range("A6", [A65536].End(xlUp)).SpecialCells(xlCellTypeConstants, xlTextValues)
'si cette personne est en vacance
If Range("S" & Nom.Row).Value = "VACANCE" Then
'dans la feuille Remplacement
With Sheets("Remplacement")
'trouve cette personne
Set Trouve = .Columns(1).Find(Nom.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not Trouve Is Nothing Then
'ici on identifie la colonne correspondant à la personne de remplacement
ColChoix = .Range("IV" & Trouve.Row).End(xlToLeft).Column
'la boucle permet de gérer l'absence ou non des personnes remplaçantes
Do
'on cherche la personne de remplacement dans la feuille Horaire Viandes
Set Remplace = Columns(1).Find(.Cells(Trouve.Row, ColChoix).Value, LookIn:=xlValues, lookat:=xlWhole)
'si cette personne de remplacement n'est pas également en vacance
If Range("S" & Remplace.Row).Value <> "VACANCE" Then
'on copie les horaires de la semaine
Range("G" & Remplace.Row & ":M" & Remplace.Row).Value = Range("G" & Nom.Row & ":M" & Nom.Row).Value
'on copie horaire colonne D
Range("D" & Remplace.Row + 1).Value = Range("D" & Nom.Row + 1).Value
'on sort de la boucle
Exit Do
End If
'sinon on identifie la colonne correspondant à la personne de remplacement suivante
ColChoix = ColChoix - 1
Loop
End If
End With
End If
Next
End Sub
Selon la feuille Remplacement:
Le remplaçant de Yves, s'il est en vacance, sera Pierre si pierre n'est pas en vacance, sinon se sera Michel s'il n'est pas en vacance, sinon se sera Gilles.
Le remplaçant de Pierre, s'il est en vacance, sera Michel si Michel n'est pas en vacance, sinon se sera Gilles.
etc….
J'ai modifié légerement et là, ça fonctionne presque
Code:
Private Sub CommandButton1_Click()
Dim Nom As Range, Trouve As Range, Remplace As Range
'pour chaque nom colonne A
For Each Nom In Range("A6", [A65536].End(xlUp)).SpecialCells(xlCellTypeConstants, xlTextValues)
'si cette personne est en vacance
If Range("S" & Nom.Row).Value = "VACANCE" Then
'dans la feuille Remplacement
With Sheets("Remplacement")
'trouve cette personne
Set Trouve = .Columns(1).Find(Nom.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not Trouve Is Nothing Then
'ici on identifie la colonne correspondant à la personne de remplacement
ColChoix = .Range("IV" & Trouve.Row).End(xlToLeft).Column
'la boucle permet de gérer l'absence ou non des personnes remplaçantes
Do
'on cherche la personne de remplacement dans la feuille Horaire Viandes
Set Remplace = Columns(1).Find(.Cells(Trouve.Row, ColChoix).Value, LookIn:=xlValues, lookat:=xlWhole)
'si cette personne de remplacement n'est pas également en vacance
If Range("S" & Remplace.Row).Value <> "VACANCE" Then
'on copie les horaires de la semaine
Range("E" & Remplace.Row & ":Q" & Remplace.Row).Value = Range("E" & Nom.Row & ":Q" & Nom.Row).Value
Range("E" & Remplace.Row + 1 & ":Q" & Remplace.Row + 1).Value = Range("E" & Nom.Row + 1 & ":Q" & Nom.Row + 1).Value
Range("S" & Remplace.Row) = "REMPLACEMENT DE " & Nom
'on copie horaire colonne D
Range("D" & Remplace.Row + 1).Value = Range("D" & Nom.Row + 1).Value
'on sort de la boucle
Exit Do
End If
'sinon on identifie la colonne correspondant à la personne de remplacement suivante
ColChoix = ColChoix - 1
Loop
End If
End With
End If
Next
End Sub
Ou sa va pas, c'est si les 3 premiers son en vacance, et que le quatrième, non, selon la liste de remplacement, Le premier vacancier, Yves, devrait-être remplacé par Gilles et les 2 autres vacancier suivant, sans remplaçant.
Donc s'il est inscrit dans la colonne S: En remplacement de, il ne devrait pas toucher se remplaçant étant déja le remplacant d'une personne en vacance.
Dans mon code, "ColChoix" identifie la colonne du remplaçant de "droite à gauche" et toi tu veux faire de "gauche à droite" donc voici ce qu'il faut modifier (en bleu):
Code:
Private Sub CommandButton1_Click()
Dim Nom As Range, Trouve As Range, Remplace As Range
'pour chaque nom colonne A
For Each Nom In Range("A6", [A65536].End(xlUp)).SpecialCells(xlCellTypeConstants, xlTextValues)
'si cette personne est en vacance
If Range("S" & Nom.Row).Value = "VACANCE" Then
'dans la feuille Remplacement
With Sheets("Remplacement")
'trouve cette personne
Set Trouve = .Columns(1).Find(Nom.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not Trouve Is Nothing Then
'ici on identifie la colonne correspondant à la personne de remplacement
' ColChoix = .Range("IV" & Trouve.Row).End(xlToLeft).Column
[COLOR=Blue][B]ColChoix = 3[/B][/COLOR]
'la boucle permet de gérer l'absence ou non des personnes remplaçantes
Do
'on cherche la personne de remplacement dans la feuille Horaire Viandes
Set Remplace = Columns(1).Find(.Cells(Trouve.Row, ColChoix).Value, LookIn:=xlValues, lookat:=xlWhole)
'si cette personne de remplacement n'est pas également en vacance
If Range("S" & Remplace.Row).Value <> "VACANCE" Then
'on copie les horaires de la semaine
Range("E" & Remplace.Row & ":Q" & Remplace.Row).Value = Range("E" & Nom.Row & ":Q" & Nom.Row).Value
Range("E" & Remplace.Row + 1 & ":Q" & Remplace.Row + 1).Value = Range("E" & Nom.Row + 1 & ":Q" & Nom.Row + 1).Value
Range("S" & Remplace.Row) = "REMPLACEMENT DE " & Nom
'on copie horaire colonne D
Range("D" & Remplace.Row + 1).Value = Range("D" & Nom.Row + 1).Value
'on sort de la boucle
Exit Do
End If
'sinon on identifie la colonne correspondant à la personne de remplacement suivante
[COLOR=Blue][B]ColChoix = ColChoix[/B][/COLOR] [SIZE=4][B][COLOR=Blue]+[/COLOR][/B][/SIZE] [COLOR=Blue][B]1[/B][/COLOR]
Loop
End If
End With
End If
Next
End Sub
Je m'aperçois que si par exemple, dans l'exemple du fichier Excel, si les 3 premiers sont en vacance, le 4e lui, qui n'est pas en vacance, devrait remplacer Yves, car il est dans ses choix en prioritée.
En ce moment, il remplace la 3e personne en vacance.
Il faudrait qu'une fois qu'il remplace le plus plus ancien des vacanciers, selon la colonne B de la feuille "Remplacement", qu'il passe à la prochaine personne en vacance avec son remplaçant autre que celui qui remplace déjà quelqu'un..
Exemple:
Code:
Range("S" & Remplace.Row) = "REMPLACEMENT DE " & Nom
Si les trois premières personnes son en vacance don Yves, Gilles lui, qui n'est pas en vacance, remplacera Yves, qui lui, est le plus ancien que Gilles veut remplacer selon la hiérarchie.
Ainsi, Gilles aura la mention "EN REMPLACEMENT DE YVES".
Les autres, Pierre et Michel, n'ayant plus personne après Gilles, dans la liste des remplaçants, ne seront pas remplacés.
Autre exemple:
Si Yves (1) est en vacance ainsi que que Michel (3).
Si Pierre(2) à le choix de remplacer Yves(1) selon la feuille "Remplacement", alors il remplacera Yves. Et si Gilles(4) a comme choix de remplacement Yves (1) et Michel (3), du fait que Pierre(2) remplace déjà Yves (1), alors lui, il remplacera Michel (3).
Désolé, mais beaucoup de détail je sais, mais ça serais grandiose si ça se faisait.
A la première lecture je n'avais rien compris mais après réflexion, c'est logique 🙄.
En bleu les ajouts/modifs:
Code:
Private Sub CommandButton1_Click()
Dim Nom As Range, Trouve As Range, Remplace As Range
'pour chaque nom colonne A
For Each Nom In Range("A6", [A65536].End(xlUp)).SpecialCells(xlCellTypeConstants, xlTextValues)
'si cette personne est en vacance
If Range("S" & Nom.Row).Value = "VACANCE" Then
'dans la feuille Remplacement
With Sheets("Remplacement")
'trouve cette personne
Set Trouve = .Columns(1).Find(Nom.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not Trouve Is Nothing Then
'ici on identifie la colonne correspondant à la personne de remplacement
' ColChoix = .Range("IV" & Trouve.Row).End(xlToLeft).Column
ColChoix = 3
'la boucle permet de gérer l'absence ou non des personnes remplaçantes
Do
'on cherche la personne de remplacement dans la feuille Horaire Viandes
Set Remplace = Columns(1).Find(.Cells(Trouve.Row, ColChoix).Value, LookIn:=xlValues, lookat:=xlWhole)
[COLOR=Blue][B] 'si on se trouve à la fin de la liste de remplacement, message et on sort de la boucle
If Remplace.Value = "" Then
MsgBox "Il n'y a personne pour remplacer " & Nom.Value
Exit Do
End If[/B][/COLOR]
'si cette personne de remplacement n'est pas également en vacance [B][COLOR=Blue]et ne remplace pas déjà quelqu'un[/COLOR][/B]
If Range("S" & Remplace.Row).Value <> "VACANCE" [B][COLOR=Blue]And Not Range("S" & Remplace.Row).Value Like "REMPLACEMENT DE*"[/COLOR][/B] Then
'on copie les horaires de la semaine
Range("E" & Remplace.Row & ":Q" & Remplace.Row).Value = Range("E" & Nom.Row & ":Q" & Nom.Row).Value
Range("E" & Remplace.Row + 1 & ":Q" & Remplace.Row + 1).Value = Range("E" & Nom.Row + 1 & ":Q" & Nom.Row + 1).Value
Range("S" & Remplace.Row) = "REMPLACEMENT DE " & Nom
'on copie horaire colonne D
Range("D" & Remplace.Row + 1).Value = Range("D" & Nom.Row + 1).Value
'on sort de la boucle
Exit Do
End If
'sinon on identifie la colonne correspondant à la personne de remplacement suivante
ColChoix = ColChoix + 1
Loop
End If
End With
End If
Next
End Sub
Dans ce cas il faut au départ partir de la feuille Remplacement pour respecter l'ordre. Voici le code modifié un peu partout:
Code:
Private Sub CommandButton1_Click()
Dim Nom As Range, Trouve As Range, Remplace As Range
'dans la feuille Remplacement
With Sheets("Remplacement")
'pour chaque nom colonne A
For Each Nom In .Range("A3", .[A65536].End(xlUp)).SpecialCells(xlCellTypeConstants, xlTextValues)
'trouve cette personne dans Horaire Viandes
Set Trouve = Columns(1).Find(Nom.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not Trouve Is Nothing Then
'si cette personne est en vacance
If Range("S" & Trouve.Row).Value = "VACANCE" Then
'ici on identifie la colonne correspondant à la personne de remplacement
' ColChoix = .Range("IV" & Trouve.Row).End(xlToLeft).Column
ColChoix = 3
'la boucle permet de gérer l'absence ou non des personnes remplaçantes
Do
'on cherche la personne de remplacement dans la feuille Horaire Viandes
Set Remplace = Columns(1).Find(.Cells(Nom.Row, ColChoix).Value, LookIn:=xlValues, lookat:=xlWhole)
'si on se trouve à la fin de la liste de remplacement, message et on sort de la boucle
If Remplace.Value = "" Then
MsgBox "Il n'y a personne pour remplacer " & Nom.Value
Exit Do
End If
'si cette personne de remplacement n'est pas également en vacance et ne remplace pas déjà quelqu'un
If Range("S" & Remplace.Row).Value <> "VACANCE" And Not Range("S" & Remplace.Row).Value Like "REMPLACEMENT DE*" Then
'on copie les horaires de la semaine
Range("E" & Remplace.Row & ":Q" & Remplace.Row).Value = Range("E" & Trouve.Row & ":Q" & Trouve.Row).Value
Range("E" & Remplace.Row + 1 & ":Q" & Remplace.Row + 1).Value = Range("E" & Trouve.Row + 1 & ":Q" & Trouve.Row + 1).Value
Range("S" & Remplace.Row) = "REMPLACEMENT DE " & Nom
'on copie horaire colonne D
Range("D" & Remplace.Row + 1).Value = Range("D" & Trouve.Row + 1).Value
'on sort de la boucle
Exit Do
End If
'sinon on identifie la colonne correspondant à la personne de remplacement suivante
ColChoix = ColChoix + 1
Loop
End If
End If
Next
End With
End Sub
Au lieu de donner l'horaire de LABELLE PIERRE à LAVICTOIRE JACQUES et l'horaire de GADBOIS MICHEL à BELLEAU GILLES, il ne donne pas d,Horaire à Gilles Belleau et donne l'horaire de GADBOIS MICHEL à LAVICTOIRE JACQUES.
- Navigue sans publicité - Accède à Cléa, notre assistante IA experte Excel... et pas que... - Profite de fonctionnalités exclusives Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel. Je deviens Supporter XLD