XL 2016 nb d'éléments dans une liste de gestionnaire de nom

Johan_25

XLDnaute Nouveau
Bonjour le forum,

Je suis débutant depuis peu.
Sur un projet je chercher à changer automatiquement une case en fonction de celle à coté. J'ai créer une version simplifiée pour pouvoir vous le transmettre. Je m'explique :

1643451126696.png

J'ai créé une liste catégorie qui comprend la ligne 1.
Ensuite j'ai créé une liste animaux avec en son sien : Chien / Chat / Lynx / Chevreuil / Gorille
Idem pour Oiseaux / arbres etc...

Enfin à l'aide de 2 listes je demande la catégorie puis ensuite la sous catégorie. Comme le montre la capture ci dessous.
1643452261172.png

Voici ensuite mon projet :
Je souhaite que lorsque la catégorie est effacée, que la sous catégorie s'efface également (chose que j'ai réussi)
Ensuite là où je bloque, lorsque la catégorie n'a qu'un seul élément, comme Oiseaux ou Métiers, je souhaite que la sous catégorie se remplisse automatique puisqu'il n'y a qu'un choix possible.
Voici le code (très simple) que j'ai réussi a faire pour le premier point. Par contre ne je n'arrive pas a trouver comment je peux ressortir le nombre de valeur d'une liste sous vba (sur excel un nbval(indirect(....) fonctionne mais impossible de le faire sous vba)


VB:
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 8 And Target.Row = 12 Then

    If Target = "" Then
        Cells(Target.Row, 9) = ""
    'else if
    End If
    
End If

End Sub

Merci d'avance
 

Pièces jointes

  • Essai_forum.xlsm
    13.5 KB · Affichages: 3
Solution
Bonjour Robert,

Merci beaucoup de ton aide.
Malheureusement tout mon projet est basé sur ces noms. Donc j'ai pas forcément envie de les redéfinir à partir de list object.
En m'aidant ce ce que tu as fait et en utilisant mes noms j'ai réussi à faire ceci. SI ça peut aider qq'un ;)

VB:
Private Sub Worksheet_Change(ByVal Target As Range)


If Target.Column = 8 And Target.Row = 12 Then
    If Target = "" Then
        Target.Offset(0, 1).Value = ""
    Else
        Target.Offset(0, 1).Value = ""
        Set cat = ActiveWorkbook.Names(Target.Value)
        If cat.RefersToRange.Count = 1 Then
            Target.Offset(0, 1) = cat.RefersToRange.Formula
            Target.Offset(0, 1).Select
        Else
            Target.Offset(0, 1).Select...

Robert

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

J'ai transformé ton tableau en tableau structuré (ListObject), ça donne ce code :

VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim TS As ListObject 'déclare la variable TS (Tableau Structuré)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim L As String 'déclare la variable L (Liste)

If Target.Address <> "$H$12" Then Exit Sub 'si le changement a lieu ailleurs que dans H12 (la cible) , sort de la procédure
Set TS = Me.ListObjects(1) 'définit le tableau structuré TS
TV = TS.HeaderRowRange 'définit le tableau des valeurs TV (les en-têtes de TS)
L = "" 'vide la liste L
If Target.Value = "" Then 'condition 1 : si la cellule cible est effacée
    Target.Offset(0, 1).Value = "" 'efface la cellule à droite de la cible
    Target.Offset(0, 1).Validation.Delete 'supprime la validation de données de la cellule à droite de la cible
    Exit Sub 'sort de la procédure
Else 'sinon
    Target.Offset(0, 1).Value = "" 'efface le contenu de la cellule à droite de la cible
    For J = 1 To UBound(TV, 2) 'boucle sur toutes les colonnes J du tableau des valeurs TV (toutes les en-têtes)
        If TV(1, J) = Target.Value Then 'condition 2 : si la donnée ligne 1 colonne J de TV est égale à la cellule cible
            'définit la liste L (regroupe les données de la colonne J de TS en les séparant par une virgule)
            L = Join(Application.Transpose(TS.DataBodyRange.Columns(J)), ",")
            Exit For 'sort de la boucle
        End If 'fin de la condition 2
    Next J 'prochaine colonne de la boucle
    With Target.Offset(0, 1).Validation 'prend en compte la validation de données de la cellule à droite de la cible
        .Delete 'supprime la validation existante
            'condition : si le nombre de valeurs de la colonne est égal à 1
            If Application.WorksheetFunction.CountA(TS.DataBodyRange.Columns(J)) = 1 Then
                Target.Offset(0, 1).Value = TS.DataBodyRange(1, J) 'renvoie la valeur unique dans la cellule à droite de la cible
                GoTo fin 'va à l'étiquette "fin"
            End If 'fin de la condition
        .Add xlValidateList, Formula1:=L 'redéfinit la validation de données avec la liste L
    End With 'fin de la prise en compte de la validation de données de la cellule à droite de la cible
End If 'fin de la condition 1
fin: 'étiquette
Target.Offset(0, 1).Select 'sélectionne la cellule à drote de la cible
End Sub
Le fichier :
 

Pièces jointes

  • Johan_ED_v02.xlsm
    21.2 KB · Affichages: 4
Dernière édition:

Johan_25

XLDnaute Nouveau
Bonjour Robert,

Merci beaucoup de ton aide.
Malheureusement tout mon projet est basé sur ces noms. Donc j'ai pas forcément envie de les redéfinir à partir de list object.
En m'aidant ce ce que tu as fait et en utilisant mes noms j'ai réussi à faire ceci. SI ça peut aider qq'un ;)

VB:
Private Sub Worksheet_Change(ByVal Target As Range)


If Target.Column = 8 And Target.Row = 12 Then
    If Target = "" Then
        Target.Offset(0, 1).Value = ""
    Else
        Target.Offset(0, 1).Value = ""
        Set cat = ActiveWorkbook.Names(Target.Value)
        If cat.RefersToRange.Count = 1 Then
            Target.Offset(0, 1) = cat.RefersToRange.Formula
            Target.Offset(0, 1).Select
        Else
            Target.Offset(0, 1).Select
            SendKeys "%{down}"
        End If
    End If
End If

End Sub

Merci encore Robert du temps que tu as passé pour résoudre mon problème.
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 917
Membres
101 839
dernier inscrit
laurentEstrées