Discussion :

[jeremy19]

Bonjour,

J'ai un problème sur lequel je bloque depuis plusieurs jours. Je voudrais réaliser une liste déroulante dans lequel selon la valeur de la colonne précédente j'ai des choix différents. J'ai dans un premier temps pensé à la formule DECALER avec un EQUIV pour retrouver les cellules correspondantes. Seulement dans le cas où les cellules cherchées ne se suivent pas ça ne fonctionne pas. Il y a également la solution des listes en cascades seulement ceci impliquerait un trop grand nombre de listes à créer puisqu'il en faudrait une pour chacune de mes dates (voir exemple). Il faudrait une sorte de recherchev qui me permettrait de ressortir les cellules voulus, seulement la fonction recherchev classique ne ressort que la première valeur trouvé.

Je vous ai mis en pièce jointe un exemple. Il est très sommaire mais mon fichier va être amené à faire beaucoup de lignes donc il faut aussi veiller à avoir une solution pas trop coûteuse en temps de calcul, c'est pour ça que je pense qu'il faut peut être se diriger plus vers du VBA que des fonction matricielle.

Avez vous des idées ?

Merci beaucoup !

[Invité]

Bonjour,

Ce message est proche de votre problème xl-2010-filtre-liste-deroulante-liee-resolu.

Regardez, si l'emploi de listes combinées dynamiques peut résoudre votre problème.

[anasecu]

Bonjour,

c'est pour ça que je pense qu'il faut peut être se diriger plus vers du VBA que des fonction matricielle.

Je te propose cette petite macro qui crée la validation dynamiquement.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Row > 1 And Target.Column = 2 Then
        Dim cel As Range, lst As String
        With Sheets("BDD")
            For Each cel In .UsedRange.Columns(1).Cells
                If cel.Value = Target.Offset(0, -1).Value Then
                    If InStr(lst, cel.Offset(0, 1).Value) = 0 Then
                        lst = lst & cel.Offset(0, 1).Value & ","
                    End If
                End If
            Next cel
        End With
        If lst <> "" Then
            With Target.Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:=lst
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True
            End With
        End If
    End If
End Sub

Attention il faut que ta date existe ce qui n'était pas le cas sur ton classeur avec 2 années différentes sur les feuilles.
Si tu utilises une macro, il faut aussi que ton suffixe soit .xlsm

[Thautheme]

Bonjour le fil, bonjour le forum,

Même remarque qu'Anasecu... Exemple inapproprié.
Autre proposition :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Sub Macro2()
Dim OB As Worksheet 'déclare la variable OB (Onglet BDD)
Dim OF As Worksheet 'déclare la variable OF (Onglet Feuil2)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim TMP As Variant 'd;eclare la variable TMP (tableau TeMPoraire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim R As Range 'déclare la variable R (Recherche)
Dim TID() As Variant 'déclare la variable TID (Tableau des ID)
 
Set OB = Worksheets("BDD") 'définit l'onglet OB
Set OF = Worksheets("Feuil2") 'définit l'onglet OF
OF.Range("A1").CurrentRegion.Offset(1, 0).Clear 'efface d'éventuelles anciennes données de l'onglet OF
TV = OB.Range("A1").CurrentRegion 'définit le tableau des valeur TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionanire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If TV(I, 1) <> "" Then D(TV(I, 1)) = "" 'alimente le dictionnaire avec les données de la colonne 1 de TV
Next I 'prochaine ligne de la boucle
TMP = D.keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublon
For J = 0 To UBound(TMP) 'boucle 1 sur tous les éléments du tableau temporaire TMP
    K = 0: Erase TID 'initialise la variable K, vide le tableau TID
    For I = 2 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        If TV(I, 1) = TMP(J) Then 'condition : si les dates correspondent
            ReDim Preserve TID(K) 'redimensionne le tableau TID
            TID(K) = TV(I, 2) 'récupère l'ID
            K = K + 1 'incrémente K
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
    OF.Cells(J + 2, "A").Value = TMP(J) 'renvoie la date de TMP(J) dans la cellule ligne J+2 colonne A de l'onglet OF
    With OF.Cells(J + 2, "B").Validation 'prend en compte la validation de la cellule ligne J+2 colonne B de l'onglet OF
        .Delete 'efface une eventuelle ancienne validation
        .Add xlValidateList, Formula1:=Join(TID, ",") 'ajoute la liste de TID à la validation de données
    End With 'fin de la prise en compte dd la...
Next J 'prochain élément de la boucle 1
End Sub

[boisgontierjacques]

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect([b2:b1000], Target) Is Nothing And Target.Count = 1 Then
    Set f = Sheets("bdd")
    Set d = CreateObject("Scripting.Dictionary")
    tmp = Target.Offset(, -1).Value
    If tmp <> "" Then
      For Each c In f.Range("a2:a" & f.[a65000].End(xlUp).Row)
        If c.Value = tmp Then d(c.Offset(, 1).Value) = ""
      Next c
      Target.Validation.Delete
    End If
    If d.Count > 0 Then Target.Validation.Add xlValidateList, Formula1:=Join(d.keys, ",")
  End If
End Sub

Version 2 niveaux

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  '---  1er niveau
  If Not Intersect([a2:a1000], Target) Is Nothing And Target.Count = 1 Then
    Set f = Sheets("bdd")
    Set d = CreateObject("Scripting.Dictionary")
    For Each c In f.Range("a2:a" & f.[a65000].End(xlUp).Row)
        d(c.Value) = ""
    Next c
    Target.Validation.Delete
    If d.Count > 0 Then Target.Validation.Add xlValidateList, Formula1:=Join(d.keys, ",")
  End If
  '--- 2e niveau
  If Not Intersect([b2:b1000], Target) Is Nothing And Target.Count = 1 Then
    Set f = Sheets("bdd")
    Set d = CreateObject("Scripting.Dictionary")
    tmp = Target.Offset(, -1).Value
    If tmp <> "" Then
      For Each c In f.Range("a2:a" & f.[a65000].End(xlUp).Row)
        If c.Value = tmp Then d(c.Offset(, 1).Value) = ""
      Next c
      Target.Validation.Delete
    End If
    If d.Count > 0 Then Target.Validation.Add xlValidateList, Formula1:=Join(d.keys, ",")
  End If
End Sub

Boisgontier

[Thautheme]

Re,

Ahhhhhhhhhhhhhhhhhhhhhhhh ! (Cri de rage)
Trop fort !...

[jeremy19]

Parfait toutes vos solutions fonctionnent très bien, merci beaucoup !