Ingrémenter une liste déroulante sous condition

C

creolia

XLDnaute Impliqué
Bonjour à tous

Je viens vous demander de l'aide sur un projet assez complexe pour moi.j'utilise pour ma petite équipe de 80 agents un planning en ligne de disponibilité celui ci extrait en CSV les donnés dans un tableau excel il se présente comme ceci

Agent1 doit mettre ses dispos matin (M) après-midi (A) et Nuit (N) suivant les date

sur ma feuille de garde je souhaiterais avoir des menu déroulant avec uniquement les noms de ce qui on mis leur dispo dans la colonne concerné

Exemple: Agent1 le 1er du mois à mis disponible Matin(M) et Après-midi (A)
dans ma feuille Astreinte apparais son nom dans la liste déroulant du 1er du mois son nom colonne Matin et Après midi

es ce possible svp de préférence par formule autrement par macro sa me conviens aussi

vous verrez la base de donnée n'est pas top en terme de lecture matin après midi et nuit apparais pas même si on devine bien à laquelle elle correspond mais sa je peut pas changer c'est extraction en CSV du Site qui est ainsi.



je vous remercie par avance de votre aide
 

Pièces jointes

  • liste.xlsx
    12.8 KB · Affichages: 50
  • liste.xlsx
    12.8 KB · Affichages: 43
Trier par date Trier par votes
Modeste

Modeste

XLDnaute Barbatruc
Re : Ingrémenter une liste déroulante sous condition

Bonsoir creolia, le forum,

À deux endroits dans le code, remplace, dans la ligne suivante
If c = Cells(1, Target.Column) Then liste(.Cells(c.Row - (Application.Match(c, tPrestas, 0) - 1), 1).Value) = ""
Cliquez pour agrandir...
... le '1' en rouge et gras, par 34 (n° de la colonne AH)

Ça devrait régler le problème ... à confirmer par un jeu de tests aussi complet que possible! :)
 
Vote positif 0 Vote négatif
C

creolia

XLDnaute Impliqué
Re : Ingrémenter une liste déroulante sous condition

Bonjour à tous

je reviens vous demander un petit coup de main au sujet de la macro que modeste ma gentillement donner

je voudrais ajouter a la suite de M A N l’élément Pro celui ci sans condition de ligne je l'ai donc ajouter à la suite mais évidement sa fonctionne pas y a t'il d'autre endroit à modifier
je voudrais juste que si pro est afficher dans la base de donné elle face partis de la liste déroulante en respectant matin apres midi et soir

pouvez vous m'aider svp merci

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim BDDTemp As String
BDDTemp = Sheets("Garde").Range("D2")
If Not Intersect(Target, [C5:E250]) Is Nothing Then
    If Target.Count > 1 Then Exit Sub
    tPrestas = Array("M", "A", "N", "[COLOR="#FF0000"]Pro[/COLOR]")
    tPostesG = Array("Chef de poste", "CA", "PL", "EQ/CE1", "EQ/CE2", "EQ/CE3")
    lig = Application.Match(Cells(Target.Row, 1), tPostesG, 0)
    If Not IsError(lig) Then
        Set liste = CreateObject("scripting.dictionary")
        maDate = Cells(Target.Row - lig, 1)
        'On Error Resume Next
        With Sheets(BDDTemp)
        colDate = Application.Match(CDbl(maDate), .[2:2], 0)
        If IsError(colDate) Then MsgBox "Date inconnue": Exit Sub
            For Each c In .Cells(3, colDate).Resize(300, 1) 'hauteur de 300 dans BDD_Janvier à adapter
                If c = Cells(1, Target.Column) Then liste(.Cells(c.Row - (Application.Match(c, tPrestas, 0) - 1), 34).Value) = ""
            Next c
            For Each k In liste.keys
                If Application.CountIf(Cells((Target.Row - lig) + 1, Target.Column + 5).Resize(4, 1), k) = 0 _
                    And Application.CountIf(Cells((Target.Row - lig) + 1, Target.Column).Resize(6, 1), k) = 0 _
                        Then ch = ch & k & ","
            Next k
            If Len(ch) > 0 Then ch = Mid(ch, 1, Len(ch) - 1)
            Target.Validation.Delete
            Target.Validation.Add Type:=xlValidateList, Formula1:=ch
        End With
    End If
End If
If Not Intersect(Target, [H5:J250]) Is Nothing Then
    If Target.Count > 1 Then Exit Sub
    tPrestas = Array("M", "A", "N"[COLOR="#FF0000"], "Pro[/COLOR]")
    tPostesA = Array("Chef de groupe", "CA", "CE/EQ", "PL")
    lig = Application.Match(Cells(Target.Row, 7), tPostesA, 0)
    If Not IsError(lig) Then
        Set liste = CreateObject("scripting.dictionary")
        maDate = Cells(Target.Row - lig, 1)
         'On Error Resume Next
        With Sheets(BDDTemp)
        colDate = Application.Match(CDbl(maDate), .[2:2], 0)
        If IsError(colDate) Then MsgBox "Date inconnue": Exit Sub
            For Each c In .Cells(3, colDate).Resize(300, 1) 'hauteur de 20 dans BDD_Janvier à adapter
                If c = Cells(1, Target.Column) Then liste(.Cells(c.Row - (Application.Match(c, tPrestas, 0) - 1), 34).Value) = ""
            Next c
            For Each k In liste.keys
                If Application.CountIf(Cells((Target.Row - lig) + 1, Target.Column - 5).Resize(6, 1), k) = 0 _
                    And Application.CountIf(Cells((Target.Row - lig) + 1, Target.Column).Resize(4, 1), k) = 0 _
                Then ch = ch & k & ","
            Next k
            If Len(ch) > 0 Then ch = Mid(ch, 1, Len(ch) - 1)
            Target.Validation.Delete
            Target.Validation.Add Type:=xlValidateList, Formula1:=ch
        End With
    End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Application.Intersect(Target, Range("L2")) Is Nothing Then

   '********* Appel de la Macro *****************
   Module2.Test2
 End If
End Sub
 
Vote positif 0 Vote négatif
Modeste

Modeste

XLDnaute Barbatruc
Re : Ingrémenter une liste déroulante sous condition

Bonsoir,

Sans fichier, difficile pour nous de "visualiser" ce qui pourrait ou devrait changer!

Par exemple, qu'en est-il de la question que je posais dans le message #4? Tu es passé à 4 lignes, maintenant? ... ou alors je n'ai pas compris? Un petit exemple serait le bienvenu! :rolleyes:
 
Vote positif 0 Vote négatif
C

creolia

XLDnaute Impliqué
Re : Ingrémenter une liste déroulante sous condition

Bonjour modeste et merci m'avoir répondu
en fait non il y a toujours 3 lignes
le Pro c'est les professionnelle qui travail chez nous pour des raison organisation on à voulut ajouter les jour ou il etait pro ou volontaire pour différentier les gardes

je souhaiterais quand un agent met Pro que ce soit dans la ligne matin apres-midi ou Nuit celui ci apparait dans la liste déroulant adéquate.

pour réponse #4 j'ai pas trop compris ce que tu voulait savoir ...

mais tous est ok ainsi y a juste ce soucis avec pro
en fait Pro remplacerais Le M A N quand il est utilisé

merci d'avance de ta patience
j'ai repris le dernier fichier joint et ajouter dans la base de donné comment sa arrive dans les menu déroulant le nom de la personne qui à mis pro devrais apparaitre dans la bonne période et la bonne date

encore merci
 

Pièces jointes

  • Copie de Copie de Validations par macro (creolia)-1BetaV3.xlsm
    31.7 KB · Affichages: 20
Vote positif 0 Vote négatif
Modeste

Modeste

XLDnaute Barbatruc
Re : Ingrémenter une liste déroulante sous condition

Bonjour creolia,

Ce qui "fonctionnait" dans la situation de départ (déjà un tantinet "atypique") ne se satisfait pas toujours d'une "simple petite adaptation", si tu modifies quelque chose.

Là, ça devient déjà très "tiré par les cheveux": si tu décides un de ces jours d'apporter un autre changement (même s'il te paraît mineur) il sera sans aucun doute préférable de reprendre dès le départ de la conception (travailler avec un Userform, par exemple serait peut-être plus pertinent!?), sinon on va se retrouver avec une "usine à gaz"

Bref, ce qui suit nécessite encore des tests approfondis:
VB: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, [C5:E58]) Is Nothing Then
    If Target.Count > 1 Then Exit Sub
    tPrestas = Array("M", "A", "N")
    tPostesG = Array("Chef de poste", "CA", "PL", "EQ/CE1", "EQ/CE2", "EQ/CE3")
    lig = Application.Match(Cells(Target.Row, 1), tPostesG, 0)
    If Not IsError(lig) Then
        Set liste = CreateObject("scripting.dictionary")
        maDate = Cells(Target.Row - lig, 1)
        With Sheets("BDD")
        colDate = Application.Match(CDbl(maDate), .[2:2], 0)
        If IsError(colDate) Then MsgBox "Date inconnue": Exit Sub
            For Each c In .Cells(3, colDate).Resize(20, 1) 'hauteur de 20 dans BDD à adapter
                If c = Cells(1, Target.Column) Then
                    liste(.Cells(c.Row - (Application.Match(c, tPrestas, 0) - 1), 1).Value) = ""
                ElseIf UCase(c) = "PRO" And Cells(4, Target.Column) = [C4].Offset(0, (c.Row - 3) Mod 3) Then
                    agent = IIf(.Cells(c.Row, 1) <> "", .Cells(c.Row, 1), .Cells(c.Row, 1).End(xlUp))
                    liste(agent) = ""
                End If
            Next c
            For Each k In liste.keys
                If Application.CountIf(Cells((Target.Row - lig) + 1, Target.Column + 5).Resize(4, 1), k) = 0 _
                    And Application.CountIf(Cells((Target.Row - lig) + 1, Target.Column).Resize(6, 1), k) = 0 _
                        Then ch = ch & k & ","
            Next k
            If Len(ch) > 0 Then ch = Mid(ch, 1, Len(ch) - 1)
            Target.Validation.Delete
            Target.Validation.Add Type:=xlValidateList, Formula1:=ch
        End With
    End If
End If
If Not Intersect(Target, [H5:J58]) Is Nothing Then
    If Target.Count > 1 Then Exit Sub
    tPrestas = Array("M", "A", "N")
    tPostesA = Array("Chef de groupe", "CA", "CE/EQ", "PL")
    lig = Application.Match(Cells(Target.Row, 7), tPostesA, 0)
    If Not IsError(lig) Then
        Set liste = CreateObject("scripting.dictionary")
        maDate = Cells(Target.Row - lig, 1)
        With Sheets("BDD")
        colDate = Application.Match(CDbl(maDate), .[2:2], 0)
        If IsError(colDate) Then MsgBox "Date inconnue": Exit Sub
            For Each c In .Cells(3, colDate).Resize(20, 1) 'hauteur de 20 dans BDD à adapter
                If c = Cells(1, Target.Column) Then
                    liste(.Cells(c.Row - (Application.Match(c, tPrestas, 0) - 1), 1).Value) = ""
                ElseIf UCase(c) = "PRO" And Cells(4, Target.Column) = [C4].Offset(0, (c.Row - 3) Mod 3) Then
                    agent = IIf(.Cells(c.Row, 1) <> "", .Cells(c.Row, 1), .Cells(c.Row, 1).End(xlUp))
                    liste(agent) = ""
                End If
            Next c
            For Each k In liste.keys
                If Application.CountIf(Cells((Target.Row - lig) + 1, Target.Column - 5).Resize(6, 1), k) = 0 _
                    And Application.CountIf(Cells((Target.Row - lig) + 1, Target.Column).Resize(4, 1), k) = 0 _
                Then ch = ch & k & ","
            Next k
            If Len(ch) > 0 Then ch = Mid(ch, 1, Len(ch) - 1)
            Target.Validation.Delete
            Target.Validation.Add Type:=xlValidateList, Formula1:=ch
        End With
    End If
End If
End Sub
 
Vote positif 0 Vote négatif
C

creolia

XLDnaute Impliqué
Re : Ingrémenter une liste déroulante sous condition

Bonjour modeste et merci pour la modification je comprend ce que tu dit c'est sur après sa peut devenir plus que compliquer mais on arrête la les modif.

j'ai vue que tu à ajouter donc ce bout de code
Code: 
 ElseIf UCase(c) = "PRO" And Cells(4, Target.Column) = [AH].Offset(0, (c.Row - 3) Mod 3) Then
                    agent = IIf(.Cells(c.Row, 34) <> "", .Cells(c.Row, 34), .Cells(c.Row, 34).End(xlUp))
                    liste(agent) = ""
                End If
            Next c

mais lors de nos anciennes conversation la liste des non était en colonne AH pour réduire la taille des nom
donc comme tu peut voir au dessus j'ai essayer comme un grand de remplacer par 34 et AH mais sa me cherche la liste des non en colonne A juste peut tu me dire ou je pourais faire ces modif merci
 
Vote positif 0 Vote négatif
C

creolia

XLDnaute Impliqué
Re : Ingrémenter une liste déroulante sous condition

Re bonsoir aprés plus de recherche j'ai trouver comment faire en haut du code et tout en bas

Code: 
 ElseIf UCase(c) = "PRO" And Cells(4, Target.Column) = [C4].Offset(0, (c.Row - 3) Mod 3) Then
                    agent = IIf(.Cells(c.Row, 34) <> "", .Cells(c.Row, 34), .Cells(c.Row, 34).End(xlUp))
                    liste(agent) = ""
                End If
            Next c


ce qui donne
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim BDDTemp As String
BDDTemp = Sheets("Garde").Range("D2")
If Not Intersect(Target, [C5:E250]) Is Nothing Then
    If Target.Count > 1 Then Exit Sub
    tPrestas = Array("M", "A", "N")
    tPostesG = Array("Chef de poste", "CA", "PL", "EQ/CE1", "EQ/CE2", "EQ/CE3")
    lig = Application.Match(Cells(Target.Row, 1), tPostesG, 0)
    If Not IsError(lig) Then
        Set liste = CreateObject("scripting.dictionary")
        maDate = Cells(Target.Row - lig, 1)
        With Sheets(BDDTemp)
        colDate = Application.Match(CDbl(maDate), .[2:2], 0)
        If IsError(colDate) Then MsgBox "Date inconnue": Exit Sub
            For Each c In .Cells(3, colDate).Resize(300, 1) 'hauteur de 300 dans BDD_Janvier à adapter
               If c = Cells(1, Target.Column) Then
                    liste(.Cells(c.Row - (Application.Match(c, tPrestas, 0) - 1), 34).Value) = ""
                ElseIf UCase(c) = "PRO" And Cells(4, Target.Column) = [C4].Offset(0, (c.Row - 3) Mod 3) Then
                    agent = IIf(.Cells(c.Row, 34) <> "", .Cells(c.Row, 34), .Cells(c.Row, 34).End(xlUp))
                    liste(agent) = ""
                End If
            Next c
            For Each k In liste.keys
                If Application.CountIf(Cells((Target.Row - lig) + 1, Target.Column + 5).Resize(4, 1), k) = 0 _
                    And Application.CountIf(Cells((Target.Row - lig) + 1, Target.Column).Resize(6, 1), k) = 0 _
                        Then ch = ch & k & ","
            Next k
            If Len(ch) > 0 Then ch = Mid(ch, 1, Len(ch) - 1)
            Target.Validation.Delete
            Target.Validation.Add Type:=xlValidateList, Formula1:=ch
        End With
    End If
End If


If Not Intersect(Target, [H5:J250]) Is Nothing Then
    If Target.Count > 1 Then Exit Sub
    tPrestas = Array("M", "A", "N")
    tPostesA = Array("Chef de groupe", "CA", "CE/EQ", "PL")
    lig = Application.Match(Cells(Target.Row, 7), tPostesA, 0)
    If Not IsError(lig) Then
        Set liste = CreateObject("scripting.dictionary")
        maDate = Cells(Target.Row - lig, 1)
        With Sheets(BDDTemp)
        colDate = Application.Match(CDbl(maDate), .[2:2], 0)
        If IsError(colDate) Then MsgBox "Date inconnue": Exit Sub
            For Each c In .Cells(3, colDate).Resize(300, 1) 'hauteur de 20 dans BDD_Janvier à adapter
               If c = Cells(1, Target.Column) Then
                    liste(.Cells(c.Row - (Application.Match(c, tPrestas, 0) - 1), 34).Value) = ""
                ElseIf UCase(c) = "PRO" And Cells(4, Target.Column) = [C4].Offset(0, (c.Row - 3) Mod 3) Then
                    agent = IIf(.Cells(c.Row, 34) <> "", .Cells(c.Row, 34), .Cells(c.Row, 34).End(xlUp))
                    liste(agent) = ""
                End If
            Next c
            For Each k In liste.keys
                If Application.CountIf(Cells((Target.Row - lig) + 1, Target.Column - 5).Resize(6, 1), k) = 0 _
                    And Application.CountIf(Cells((Target.Row - lig) + 1, Target.Column).Resize(4, 1), k) = 0 _
                Then ch = ch & k & ","
            Next k
            If Len(ch) > 0 Then ch = Mid(ch, 1, Len(ch) - 1)
            Target.Validation.Delete
            Target.Validation.Add Type:=xlValidateList, Formula1:=ch
        End With
    End If
End If
End Sub


Encore merci pour tout ton aide et l'apprentissage que sa m'apporte une bonne soirée
 
Vote positif 0 Vote négatif

Discussions similaires

Daniel38
  • Résolu(e)
Insérer une somme variable à chaque changement de jour pour calculer les heures totales par jour
Réponses
10
Affichages
385
Dranreb
Dranreb
E
  • Question
Microsoft 365 VBA Calendrier, rien ne se passe.
Réponses
12
Affichages
621
fanch55
fanch55
L
  • Question
XL 2019 Trier une liste de noms latins en couleur sans doublons depuis une combobox d'un userform
2
Réponses
29
Affichages
2 K
lusert
L
Lu76Fer
XLS : Créer une animation fluide sans Crash (ou presque) !
Réponses
7
Affichages
296
Lu76Fer
Lu76Fer
P
  • Question
XL 2016 Créer un tirage aléatoire, mais avec critères/conditions ?
Réponses
9
Affichages
927
patricktoulon
patricktoulon
J
  • Question
XL 2016 Ajout lignes dans fichier CSV avec filtrage - VBA
Réponses
2
Affichages
1 K
Joshua P
J
oguruma
POWERQUERY :: Combinaisons (Table.Combine) de dossiers contenant des fichiers .CSV ou des fichiers Excel - V2
Réponses
0
Affichages
275
oguruma
oguruma
C
  • Résolu(e)
XL 2016 Recherche de valeurs dans différents onglets et affichage conditionnel ?
Réponses
14
Affichages
1 K
calvinethobbes
C
O
  • Question
XL 2013 Modifier une base de donnée depuis un formulaire USF
Réponses
8
Affichages
1 K
Dranreb
Dranreb
S
  • Question
Autres Calcul avec condition.
Réponses
2
Affichages
527
Shimano
S

Membres actuellement en ligne

22 membres et 271 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 233
Messages
2 086 465
Membres
103 224
dernier inscrit
VieuxSeb