Liste déroulante sans doublon

Xave2878

XLDnaute Nouveau
Bonjour à tous,

Je suis face à un problème de liste déroulante: J'ai une base de données avec 4 colonnes (onglets / Niv3 / niv 34 / Niv4)
Et de temps en temps, il y a des cases blanches mais avec un lien avec la colonne d'après et d'avant.
J'arrive pas à m'en sortir pour avoir une liste déroulante sans doublon ni de blancs. De plus dans mes formules de validation, les cases blanches ne sont pas prises en compte.

Quelqu'un pourrait-il m'aider?

Je vous remercie
 

Pièces jointes

  • essai.xlsx
    103.7 KB · Affichages: 20

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour Xave, bonjour le forum,

Une proposition par VBA avec le code ci-dessous à placer dans le composant : Feuil2 (Recherche).


VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim BD As Worksheet 'déclare la varaible BD
Dim TV As Variant 'déclare la varaible TV (Tableau des Valeurs)
Dim D1 As Object 'déclare la varaible D1 (Dictionnaire 1)
Dim D2 As Object 'déclare la varaible D2 (Dictionnaire 2)
Dim D3 As Object 'déclare la varaible D3 (Dictionnaire 3)
Dim I As Integer 'déclare la varaible I (Incrément)
Dim J As Integer 'déclare la varaible J (incrément)
Dim L1 As String 'déclare la varaible L1 (Liste 1)
Dim L2 As String 'déclare la varaible L2 (Liste 2)
Dim L3 As String 'déclare la varaible L3 (Liste 3)

Set BD = Worksheets("BD") 'définit l'onglet BD
TV = BD.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
Set D1 = CreateObject("Scripting.Dictionary") 'définit le dictionnaire 1
Set D2 = CreateObject("Scripting.Dictionary") 'définit le dictionnaire 2
Set D3 = CreateObject("Scripting.Dictionary") 'définit le dictionnaire 3
If Target.Column = 2 And Target.Row > 2 Then 'condition 1 : si la cellule modifiée se trouve dans la colonne 2 (=> colonne B) et sur n'importe quelle ligne après la 2
    For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs en partant de la seconde
        If TV(I, 1) = Target.Value Then 'condition 2 : si la donnée en colonne 1 de TV est égale à ma cellule modifiée [onglet]
            If TV(I, 2) <> "" Then D1(TV(I, 2)) = "" 'si la cellule en colonne 2 de TV n'est pas vide, alimente le dictionaire D1
            If TV(I, 3) <> "" Then D2(TV(I, 3)) = "" 'si la cellule en colonne 3 de TV n'est pas vide, alimente le dictionaire D2
            If TV(I, 4) <> "" Then D3(TV(I, 4)) = "" 'si la cellule en colonne 4 de TV n'est pas vide, alimente le dictionaire D3
        End If 'fin de la condition 2
    Next I 'prochaine ligne de la boucle
    L1 = Join(D1.Keys, ",") 'définit la liste L1 (D1.keys correpond à la liste des éléments du dictionnaire D1 sans doublons)
    L2 = Join(D2.Keys, ",") 'définit la liste L2(D2.keys correpond à la liste des éléments du dictionnaire D2 sans doublons)
    L3 = Join(D3.Keys, ",") 'définit la liste L3(D3.keys correpond à la liste des éléments du dictionnaire D3 sans doublons)
    Target.Offset(0, 1).Resize(1, 3).ClearContents 'efface les cellules en colonnes C, D et E
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
    Target.Offset(0, 1).Validation.Delete 'efface une éventuelle validation de donnée dans la cellule en colonne C
    Target.Offset(0, 1).Validation.Add xlValidateList, Formula1:=L1 'utilise le liste L1 pour la validation de données en colonne C (génère une erreur si L1 est vide)
    Target.Offset(0, 2).Validation.Delete 'efface une éventuelle validation de donnée dans la cellule en colonne D
    Target.Offset(0, 2).Validation.Add xlValidateList, Formula1:=L2 'utilise le liste L2 pour la validation de données en colonne D (génère une erreur si L1 est vide)
    Target.Offset(0, 3).Validation.Delete 'efface une éventuelle validation de donnée dans la cellule en colonne E
    Target.Offset(0, 3).Validation.Add xlValidateList, Formula1:=L3 'utilise le liste L3 pour la validation de données en colonne E (génère une erreur si L1 est vide)
End If 'fin de la condition 1
End Sub
 

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Bonjour,

VB:
Dim zSaisie, NbNiv
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Set zSaisie = Range("A2:D10")
    NbNiv = 4
    If Not Intersect(zSaisie, Target) Is Nothing And Target.Count = 1 Then
      TblMap = [Table1].Value
      Set d1 = CreateObject("Scripting.Dictionary")
      nivCourant = Target.Column - zSaisie.Column + 1
      Dim Tmp(): ReDim Tmp(1 To nivCourant)
      For k = 1 To nivCourant - 1
        Tmp(k) = Target.Offset(, -(nivCourant - k))
      Next k
      For i = 1 To UBound(TblMap)
         témoin = True
         For k = 1 To nivCourant - 1
            If TblMap(i, k) <> Tmp(k) Then témoin = False: Exit For
         Next k
         If témoin Then d1(TblMap(i, nivCourant)) = ""
       Next i
       If d1.Count > 0 Then
           Target.Validation.Delete
           Set Rng = [H2].Resize(d1.Count)   ' adapter H2
           Rng.Resize(100).ClearContents
           Rng.Value = Application.Transpose(d1.keys)
           Target.Validation.Add xlValidateList, Formula1:="=" & Rng.Address
        End If
    End If
 End Sub

Boisgontier
 

Pièces jointes

  • DV4Niveaux.xlsm
    49.7 KB · Affichages: 17

Xave2878

XLDnaute Nouveau
Bonjour Xave, bonjour le forum,

Une proposition par VBA avec le code ci-dessous à placer dans le composant : Feuil2 (Recherche).


VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim BD As Worksheet 'déclare la varaible BD
Dim TV As Variant 'déclare la varaible TV (Tableau des Valeurs)
Dim D1 As Object 'déclare la varaible D1 (Dictionnaire 1)
Dim D2 As Object 'déclare la varaible D2 (Dictionnaire 2)
Dim D3 As Object 'déclare la varaible D3 (Dictionnaire 3)
Dim I As Integer 'déclare la varaible I (Incrément)
Dim J As Integer 'déclare la varaible J (incrément)
Dim L1 As String 'déclare la varaible L1 (Liste 1)
Dim L2 As String 'déclare la varaible L2 (Liste 2)
Dim L3 As String 'déclare la varaible L3 (Liste 3)

Set BD = Worksheets("BD") 'définit l'onglet BD
TV = BD.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
Set D1 = CreateObject("Scripting.Dictionary") 'définit le dictionnaire 1
Set D2 = CreateObject("Scripting.Dictionary") 'définit le dictionnaire 2
Set D3 = CreateObject("Scripting.Dictionary") 'définit le dictionnaire 3
If Target.Column = 2 And Target.Row > 2 Then 'condition 1 : si la cellule modifiée se trouve dans la colonne 2 (=> colonne B) et sur n'importe quelle ligne après la 2
    For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs en partant de la seconde
        If TV(I, 1) = Target.Value Then 'condition 2 : si la donnée en colonne 1 de TV est égale à ma cellule modifiée [onglet]
            If TV(I, 2) <> "" Then D1(TV(I, 2)) = "" 'si la cellule en colonne 2 de TV n'est pas vide, alimente le dictionaire D1
            If TV(I, 3) <> "" Then D2(TV(I, 3)) = "" 'si la cellule en colonne 3 de TV n'est pas vide, alimente le dictionaire D2
            If TV(I, 4) <> "" Then D3(TV(I, 4)) = "" 'si la cellule en colonne 4 de TV n'est pas vide, alimente le dictionaire D3
        End If 'fin de la condition 2
    Next I 'prochaine ligne de la boucle
    L1 = Join(D1.Keys, ",") 'définit la liste L1 (D1.keys correpond à la liste des éléments du dictionnaire D1 sans doublons)
    L2 = Join(D2.Keys, ",") 'définit la liste L2(D2.keys correpond à la liste des éléments du dictionnaire D2 sans doublons)
    L3 = Join(D3.Keys, ",") 'définit la liste L3(D3.keys correpond à la liste des éléments du dictionnaire D3 sans doublons)
    Target.Offset(0, 1).Resize(1, 3).ClearContents 'efface les cellules en colonnes C, D et E
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
    Target.Offset(0, 1).Validation.Delete 'efface une éventuelle validation de donnée dans la cellule en colonne C
    Target.Offset(0, 1).Validation.Add xlValidateList, Formula1:=L1 'utilise le liste L1 pour la validation de données en colonne C (génère une erreur si L1 est vide)
    Target.Offset(0, 2).Validation.Delete 'efface une éventuelle validation de donnée dans la cellule en colonne D
    Target.Offset(0, 2).Validation.Add xlValidateList, Formula1:=L2 'utilise le liste L2 pour la validation de données en colonne D (génère une erreur si L1 est vide)
    Target.Offset(0, 3).Validation.Delete 'efface une éventuelle validation de donnée dans la cellule en colonne E
    Target.Offset(0, 3).Validation.Add xlValidateList, Formula1:=L3 'utilise le liste L3 pour la validation de données en colonne E (génère une erreur si L1 est vide)
End If 'fin de la condition 1
End Sub

Bonjour Robert et merci tout d'abord de ta proposition.

Cependant, ça ne marche pas comme je souhaiterai: je t'explique:
Quand je choisis dans la colonne Onglets "ACOUSTIQUE", et que je choisis dans la colonne niv3 "Bruits et vibrations BMF", je ne dois voir dans la colonne niv34, une liste blanche et ensuite dans la colonne niv4, je dois voir "Bourdonnement bas régime","Bourdonnement mi régime", "Bourdonnement haut régime", GMP BF Vibrations en roulage", "GMP MF (Grondement, Présence)"
 

Xave2878

XLDnaute Nouveau
Bonjour,

VB:
Dim zSaisie, NbNiv
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Set zSaisie = Range("A2:D10")
    NbNiv = 4
    If Not Intersect(zSaisie, Target) Is Nothing And Target.Count = 1 Then
      TblMap = [Table1].Value
      Set d1 = CreateObject("Scripting.Dictionary")
      nivCourant = Target.Column - zSaisie.Column + 1
      Dim Tmp(): ReDim Tmp(1 To nivCourant)
      For k = 1 To nivCourant - 1
        Tmp(k) = Target.Offset(, -(nivCourant - k))
      Next k
      For i = 1 To UBound(TblMap)
         témoin = True
         For k = 1 To nivCourant - 1
            If TblMap(i, k) <> Tmp(k) Then témoin = False: Exit For
         Next k
         If témoin Then d1(TblMap(i, nivCourant)) = ""
       Next i
       If d1.Count > 0 Then
           Target.Validation.Delete
           Set Rng = [H2].Resize(d1.Count)   ' adapter H2
           Rng.Resize(100).ClearContents
           Rng.Value = Application.Transpose(d1.keys)
           Target.Validation.Add xlValidateList, Formula1:="=" & Rng.Address
        End If
    End If
End Sub

Boisgontier
Bonjour Boisgontier.

Génial c'est exactement ce que je voulais. T'es trop fort. Cependant, vu que je ne connais rien en langage VBA, mes colonnes dans mon fichier ne se trouvent pas à la même place que toi:

la colonne Onglets sera en colonne J, niv3 en K, Niv34 en M et niv4 en O

Si tu sais me dire quoi modifier ça serait super. Merci encore bcp pour ton aide

Xave
 

Pièces jointes

  • essai 2.xlsm
    109.1 KB · Affichages: 3

Discussions similaires

Réponses
8
Affichages
364

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof