Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

smou

XLDnaute Nouveau
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!
 

Pièces jointes

  • Liste_en_cascade.xlsx
    14.8 KB · Affichages: 33

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Bonjour,

Exemple en PJ

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

Code:
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
 

Pièces jointes

  • Copie de ListeCascade4NivBDIncomplete2.xls
    63.5 KB · Affichages: 23
  • ListeCascade4NivBDIncompleteHoriz.xls
    63.5 KB · Affichages: 17
Dernière édition:

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…