Microsoft 365 Liste déroulante selon critère

F

FCMLE44

XLDnaute Impliqué
Bonjour

Dans la cellule I2, je souhaite intégrer une liste de choix conditionnelle
Je m'explique :
Lorsqu'en cellule H1, j'ai par exemple XXXX, j'aurais dans ma liste de choix toutes les sociétés de la colonne 1 correspondant à XXXX se trouvant dans la colonne F

Je sais faire les validations de données mais ca, je sèche.

Quelqu'un aurait il une idée ?

Merci
 

Pièces jointes

Solution
cp4
FCMLE44 à dit:
Si par mégarde je clique sur la cellule B13 de la feuille salariés, j'obtiens une erreur d'exécution 1004.
Que pourrais je rajouter dans ce code pour que le débogage n'ait pas lieu
Merci
Cliquez pour agrandir...
VB: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Dim Rng As Range, c As Range, d As Object

   With Sheets("Paramètres")
      Set Rng = .Range("J2:J" & .Range("J" & Rows.Count).End(xlUp).Row)
   End With

   If Target.Address = "$D$4" Then
      Set d = CreateObject("Scripting.Dictionary")
      For Each c In Rng: d(c.Value) = "": Next c
      Target.Validation.Delete
      Target.Validation.Add xlValidateList, Formula1:=Join(d.keys, ",")
   End If

   If Target.Address = "$B$13" Then
      Set d =...
Trier par date Trier par votes
F

FCMLE44

XLDnaute Impliqué
cp4 à dit:
Bonsoir,

Si j'ai bien compris ta demande. Le code est dans le module de la feuille.

Bonne soirée.

edit: bonsoir JHA ;)
Cliquez pour agrandir...

Bonjour

Je n'ai pas réussi à reproduire sur mon fichier réel
Les données sociétés et RG se trouvent effet sur la feuille parametres
Le listes déroulantes sont sur la feuille salariés

J'ai mis cà dans le la feuille salarié ave les bonnes cellules

VB: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Rng As Range, c As Range, d As Object

Sheets("Paramètres").Select
Set Rng = Range("J2:J" & Range("D" & Rows.Count).End(xlUp).Row)
'End With

Sheets("salariés").Select
If Target.Address = "$D$4" Then
    Set d = CreateObject("Scripting.Dictionary")
    For Each c In Rng: d(c.Value) = "": Next c
   Target.Validation.Delete
    Target.Validation.Add xlValidateList, Formula1:=Join(d.keys, ",")
  End If

If Target.Address = "$b$13" Then
    Set d = CreateObject("Scripting.Dictionary")
    For Each c In Rng
If c.Value = Range("$D$4").Value Then
d(c.Offset(0, -5).Value) = ""
End If

Next c
   Target.Validation.Delete
    Target.Validation.Add xlValidateList, Formula1:=Join(d.keys, ",")
  End If
End Sub

Cela ne fonctionne pas
Voici le fichier vide des données personnelles

Auriez vous une idée ?
 

Pièces jointes

Vote positif 0 Vote négatif
cp4

cp4

XLDnaute Barbatruc
FCMLE44 à dit:
Bonjour

Je n'ai pas réussi à reproduire sur mon fichier réel
Les données sociétés et RG se trouvent effet sur la feuille parametres
Le listes déroulantes sont sur la feuille salariés

J'ai mis cà dans le la feuille salarié ave les bonnes cellules

VB: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Rng As Range, c As Range, d As Object

Sheets("Paramètres").Select
Set Rng = Range("J2:J" & Range("D" & Rows.Count).End(xlUp).Row)
'End With

Sheets("salariés").Select
If Target.Address = "$D$4" Then
    Set d = CreateObject("Scripting.Dictionary")
    For Each c In Rng: d(c.Value) = "": Next c
   Target.Validation.Delete
    Target.Validation.Add xlValidateList, Formula1:=Join(d.keys, ",")
  End If

If Target.Address = "$b$13" Then
    Set d = CreateObject("Scripting.Dictionary")
    For Each c In Rng
If c.Value = Range("$D$4").Value Then
d(c.Offset(0, -5).Value) = ""
End If

Next c
   Target.Validation.Delete
    Target.Validation.Add xlValidateList, Formula1:=Join(d.keys, ",")
  End If
End Sub

Cela ne fonctionne pas
Voici le fichier vide des données personnelles

Auriez vous une idée ?
Cliquez pour agrandir...
Bonjour,

@FCMLE44 : Les .Select sont à éviter, ils ralentissent le code. Le code est dans le module de la feuille "Salariés" pourquoi mettre Sheets("Salariés").Select?

Code corrigé ci-dessous
VB: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Dim Rng As Range, c As Range, d As Object

   With Sheets("Paramètres")
      Set Rng = .Range("J2:J" & .Range("J" & Rows.Count).End(xlUp).Row)
   End With

   If Target.Address = "$D$4" Then
      Set d = CreateObject("Scripting.Dictionary")
      For Each c In Rng: d(c.Value) = "": Next c
      Target.Validation.Delete
      Target.Validation.Add xlValidateList, Formula1:=Join(d.keys, ",")
   End If

   If Target.Address = "$B$13" Then
      Set d = CreateObject("Scripting.Dictionary")
      For Each c In Rng
         ' c est en col J on veut atteindre la société en col D, donc on se déplace à gauche de la colJ (soit -6)
         If c.Value = Range("$D$4").Value Then d(c.Offset(0, -6).Value) = ""
      Next c
      Target.Validation.Delete
      Target.Validation.Add xlValidateList, Formula1:=Join(d.keys, ",")
   End If
End Sub

Bonne journée.
 
Vote positif 0 Vote négatif
F

FCMLE44

XLDnaute Impliqué
cp4 à dit:
Bonjour,

@FCMLE44 : Les .Select sont à éviter, ils ralentissent le code. Le code est dans le module de la feuille "Salariés" pourquoi mettre Sheets("Salariés").Select?

Code corrigé ci-dessous
VB: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Dim Rng As Range, c As Range, d As Object

   With Sheets("Paramètres")
      Set Rng = .Range("J2:J" & .Range("J" & Rows.Count).End(xlUp).Row)
   End With

   If Target.Address = "$D$4" Then
      Set d = CreateObject("Scripting.Dictionary")
      For Each c In Rng: d(c.Value) = "": Next c
      Target.Validation.Delete
      Target.Validation.Add xlValidateList, Formula1:=Join(d.keys, ",")
   End If

   If Target.Address = "$B$13" Then
      Set d = CreateObject("Scripting.Dictionary")
      For Each c In Rng
         ' c est en col J on veut atteindre la société en col D, donc on se déplace à gauche de la colJ (soit -6)
         If c.Value = Range("$D$4").Value Then d(c.Offset(0, -6).Value) = ""
      Next c
      Target.Validation.Delete
      Target.Validation.Add xlValidateList, Formula1:=Join(d.keys, ",")
   End If
End Sub

Bonne journée.
Cliquez pour agrandir...
Si par mégarde je clique sur la cellule B13 de la feuille salariés, j'obtiens une erreur d'exécution 1004.
Que pourrais je rajouter dans ce code pour que le débogage n'ait pas lieu
Merci
 
Vote positif 0 Vote négatif
cp4

cp4

XLDnaute Barbatruc
FCMLE44 à dit:
Si par mégarde je clique sur la cellule B13 de la feuille salariés, j'obtiens une erreur d'exécution 1004.
Que pourrais je rajouter dans ce code pour que le débogage n'ait pas lieu
Merci
Cliquez pour agrandir...
VB: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Dim Rng As Range, c As Range, d As Object

   With Sheets("Paramètres")
      Set Rng = .Range("J2:J" & .Range("J" & Rows.Count).End(xlUp).Row)
   End With

   If Target.Address = "$D$4" Then
      Set d = CreateObject("Scripting.Dictionary")
      For Each c In Rng: d(c.Value) = "": Next c
      Target.Validation.Delete
      Target.Validation.Add xlValidateList, Formula1:=Join(d.keys, ",")
   End If

   If Target.Address = "$B$13" Then
      Set d = CreateObject("Scripting.Dictionary")
      For Each c In Rng
         ' c est en col J on veut atteindre la société en col D, donc on se déplace à gauche de la colJ (soit -6)
         If c.Value = Range("$D$4").Value Then d(c.Offset(0, -6).Value) = ""
      Next c
      If d.Count = 0 Then
         MsgBox "Veuillez sélectionner Nom du RG!", vbokonky + vbCritical, "ECHEC....."
         Exit Sub
      Else
         Target.Validation.Delete
         Target.Validation.Add xlValidateList, Formula1:=Join(d.keys, ",")
      End If
   End If
End Sub
 
Vote positif 0 Vote négatif
Solution

Discussions similaires

P
  • Résolu(e)
XL 2010 Liste déroulante / Formule indirect
Réponses
2
Affichages
314
pomunho
P
C
  • Question Question
XL 2021 afficher une liste déroulante
Réponses
3
Affichages
325
chrislecycliste
C
T
  • Question Question
XL 2013 Colonne dynamique en fonction de choix d'une liste déroulante
Réponses
5
Affichages
603
JHA
J
S
  • Question Question
Microsoft 365 liste déroulante choix multiples
Réponses
6
Affichages
454
sylvie0912
S
J
  • Question Question
XL 2016 RechercheV sur liste déroulante !
Réponses
8
Affichages
661
Jaykerz
J
E
  • Résolu(e)
XL 2019 Création d'une liste déroulante en cascade
Réponses
3
Affichages
682
Ericduke
E
T
  • Question Question
Microsoft 365 Garder les doublons dans une liste déroulante
Réponses
3
Affichages
364
djidji59430
djidji59430
J
  • Question Question
Autres [Google Sheets] Recherchev, index, equiv sur liste déroulante - A l'aide !
Réponses
2
Affichages
671
Jaykerz
J
R
  • Question Question
XL 2010 Problème avec liste déroulante sur des cellule déjà rempli
Réponses
6
Affichages
502
rider
R
S
  • Résolu(e)
XL 2019 Liste selon cellule
Réponses
5
Affichages
287
Sarahphil
S
A
  • Question Question
XL 2010 Liste déroulante
Réponses
2
Affichages
536
WTF
WTF
C
  • Question Question
XL 2021 Dupliquer un fichier selon une liste déroulante
Réponses
2
Affichages
220
catdog
C
T
  • Résolu(e)
XL 2013 Liste déroulante 1 colonne sur 2
Réponses
2
Affichages
476
JHA
J
Z
  • Question Question
XL 2016 RECHERCHEV et double liste de choix
Réponses
2
Affichages
780
zendb
Z
M
  • Résolu(e)
XL 2021 Liste déroulante avec plusieurs conditions
Réponses
7
Affichages
617
MORAD AIT
M
I
  • Résolu(e)
XL 2021 Somme cellule a droite du critère 1 ligne plusieurs colonnes
Réponses
5
Affichages
202
Idealnight
I
C
  • Question Question
Microsoft 365 Liste déroulante en colonne 2 en fonction de la colonne 1
Réponses
9
Affichages
724
chris
chris
G
  • Question Question
XL 2016 RechercheV dans plusieurs tableaux
Réponses
2
Affichages
316
grumeau10
G
Nicolas JACQUIN
  • Question Question
XL 2021 Récupération n° du mois depuis liste déroulante texte pour macro
Réponses
4
Affichages
301
mapomme
mapomme
P
  • Résolu(e)
Autres Choix selon plusieurs critères
Réponses
2
Affichages
378
Pascal22100
P

Membres actuellement en ligne

25 membres et 292 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
315 297
Messages
2 118 164
Membres
113 440
dernier inscrit
RonanB