Liste en cascade et sans blanc à partir d'un fichier qui contient des cellules vides

[smou]

Bonjour et merci pour la richesse de ce forum.
J'ai regardé attentivement les autres discussions mais il me semble ici avoir un cas non traité encore.
En fait je récupère d'un autre service sur un Google Doc une liste (category_tree) qui évolue régulièrement.
Je souhaite donc faire de temps en temps des copier/coller de ce Google Doc sur mon Excel.
Je précise cela car je ne peux donc pas changer la mise en forme du document source.
Cette liste n'est pas formatée comme une base de donnée facilement exploitable.
Il y a en effet plein de blancs.

Mon objectif est d'avoir des listes en cascade (dans l'onglet 'liste') qui reprendrait (sans doublon et sans blanc) les valeurs de chacune des colonnes de category_tree.
J'ai essayé avec des formules excel mais cela me semble trop complexe.

Merci beaucoup pour votre aide.
Cela simplifierait beaucoup la vie de nos équipes!

 

[BOISGONTIER]

Bonjour,

Exemple en PJ

http://boisgontierjacques.free.fr/fichiers/DonneesValidation/ListeCascade4NivBDIncompleteHoriz.xls

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect([A2:A100], Target) Is Nothing Then
      Set d1 = CreateObject("Scripting.Dictionary")
      For Each c In [niveau1]:  d1(c.Value) = "": Next c
      Target.Validation.Delete
      Target.Validation.Add xlValidateList, Formula1:=Join(d1.keys, ",")
     End If
     '-- niv 2
     If Not Intersect([B2:B100], Target) Is Nothing Then
       Set d1 = CreateObject("Scripting.Dictionary")
       For Each c In [niveau2]
         tmp = c.Offset(0, -1): If tmp = "" Then tmp = c.Offset(0, -1).End(xlUp)
         If tmp = Target.Offset(, -1) Then d1(c.Value) = ""
       Next c
       Target.Validation.Delete
       If d1.Count > 0 Then Target.Validation.Add xlValidateList, Formula1:=Join(d1.keys, ",")
     End If
     '---niv3
     If Not Intersect([C2:C100], Target) Is Nothing Then
       Set d1 = CreateObject("Scripting.Dictionary")
       For Each c In [niveau3]
        If c <> "" Then
         tmp = c.Offset(0, -2): If tmp = "" Then tmp = c.Offset(0, -2).End(xlUp)
         tmp2 = c.Offset(0, -1):  If tmp2 = "" Then tmp2 = c.Offset(0, -1).End(xlUp)
         If tmp = Target.Offset(, -2) And tmp2 = Target.Offset(, -1) Then d1(c.Value) = ""
        End If
       Next c
       Target.Validation.Delete
       If d1.Count > 0 Then
         Target.Validation.Add xlValidateList, Formula1:=Join(d1.keys, ",")
       Else
         Target = ""
       End If
    End If
    '--- niv 4
     If Not Intersect([d2:d100], Target) Is Nothing Then
       Set d1 = CreateObject("Scripting.Dictionary")
       For Each c In [niveau4]
        If c <> "" Then
         tmp = c.Offset(0, -3): If tmp = "" Then tmp = c.Offset(0, -3).End(xlUp)
         tmp2 = c.Offset(0, -2): If tmp2 = "" Then tmp2 = c.Offset(0, -2).End(xlUp)
         tmp3 = c.Offset(0, -1):  If tmp3 = "" Then tmp3 = c.Offset(0, -1).End(xlUp)
         If tmp = Target.Offset(, -3) And tmp2 = Target.Offset(, -2) And tmp3 = Target.Offset(, -1) Then d1(c.Value) = ""
        End If
       Next c
       Target.Validation.Delete
       If d1.Count > 0 Then
         For Each c In d1.keys: temp = temp & Replace(c, ",", ".") & ",": Next c
         Target.Validation.Add xlValidateList, Formula1:=Left(temp, Len(temp) - 1)
        Else
          Target = ""
        End If
    End If
End Sub

http://boisgontierjacques.free.fr/pages_site/listes_cascade.htm#BDIncomplete

jb

 

[smou]

Fantastique, merci beaucoup !
Juste une dernière chose.
Est-il possible de laisser un champ libre dans les menus déroulants?

 

[BOISGONTIER]

>Est-il possible de laisser un champ libre dans les menus déroulants?

C'est quoi un champ libre?

jb

 

[smou]

Cela autoriserait l'utilisateur à écrire une valeur qui n'est pas dans la liste déroulante.

 

[BOISGONTIER]

Il suffit d'ajouter :

Target.Validation.ShowError = False

Je ne l'ai fait que pour le 4e niveau

jb