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

XL 2010 listes et dépendances

  • Initiateur de la discussion Initiateur de la discussion poipoi
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

poipoi

XLDnaute Impliqué
Bonjour toute l'équipe,
Voici mon souci du jour et mes capacités sont largement en deçà de ce que je voudrais trouver.
Dans le tableau joint, je voudrais avoir en L4:L... la liste des valeurs uniques, extraites de la liste Fournisseurs et correspondant au type inscrit en K4!!
j'espère que vous arriverez à comprendre c'est un peu brouillon comme explication, mais en gros: si en K4 je choisis "Matériel" je souhaiterais avoir en L4 "Décathlon" en L5 "Fnac" en L6 "Xtrem Sport"...
je m'y perds dans les formules imbriquant Index, Equiv....
Auriez-vous une idée? un grand merci déjà...
 

Pièces jointes

Solution
Bonjour poipoi, le forum,

Je suis surpris que vous ne donniez pas suite à mon post précédent ☹️

Pour terminer, puisque vous êtes sur Excel 2010, voici une solution avec un classeur .xlsm et des tableaux structurés :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim critere As Range, dest As Range, tablo, i&
Set critere = [K3:K4]
Set dest = [Tableau3] '3ème tableau structuré
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
dest.ListObject.ShowTotals = False 'masque la ligne du Total
[Tableau1].ListObject.Range.AdvancedFilter xlFilterCopy, critere, dest.Rows(0) 'filtre avancé copié sur le 1er tableau structuré
dest.ListObject.Resize dest.CurrentRegion 'redimensionne le tableau
With...
On peut utiliser le filtre avancé, c'est plus simple et probablement plus rapide :
VB:
Private Sub Worksheet_Change(ByVal target As Range)
Dim critere As Range, dest As Range, tablo, i&
Set critere = [K3:K4]
Set dest = [L3:N3] '3 colonnes
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
'dest.Offset(1).Resize(Rows.Count - dest.Row).ClearContents 'RAZ inutile, à supprimer
Range("B3:F" & Range("B" & Rows.Count).End(xlUp).Row).AdvancedFilter xlFilterCopy, critere, dest 'filtre avancé copié
With Range(dest, Cells(Rows.Count, dest.Column).End(xlUp))
    .Sort .Columns(1), xlAscending, Header:=xlYes 'tri sur la 1ère colonne
    tablo = .Value 'matrice, plus rapide
    For i = UBound(tablo) To 2 Step -1
        If tablo(i, 1) = tablo(i - 1, 1) Then tablo(i, 1) = ""
    Next
    .Columns(1) = tablo
    .Cells(.Rows.Count + 1, 3) = "=SUM(" & .Columns(3).Address(0, 0) & ")" 'total
    .Offset(.Rows.Count).Resize(Rows.Count - .Rows.Count - .Row + 1).Borders.LineStyle = xlNone 'effacement des bordures
End With
Application.EnableEvents = True 'réactive les évènements
End Sub
 

Pièces jointes

Dernière édition:
Notez qu'avec le filtre avancé la 7ème ligne de la macro (RAZ) est inutile et peut être supprimée.
Absent toute la journée, je découvre avec un immense plaisir tout votre travail.
C'est exactement ce que je souhaitais et franchement je trouve cela super.
Un très grand merci Job75 pour votre patience et votre sens du don.
Merci aussi bien sûr à Djidji pour sa généreuse participation.
Je vous souhaite le meilleur.
 
Merci pour votre retour.

Mais je vois que vous avez mis comme solution votre post #19 qui en aucun cas est une solution du problème.

Merci de corriger en cochant mon post #16 (je pense).
 
Bonjour poipoi, le forum,

Je suis surpris que vous ne donniez pas suite à mon post précédent ☹️

Pour terminer, puisque vous êtes sur Excel 2010, voici une solution avec un classeur .xlsm et des tableaux structurés :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim critere As Range, dest As Range, tablo, i&
Set critere = [K3:K4]
Set dest = [Tableau3] '3ème tableau structuré
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
dest.ListObject.ShowTotals = False 'masque la ligne du Total
[Tableau1].ListObject.Range.AdvancedFilter xlFilterCopy, critere, dest.Rows(0) 'filtre avancé copié sur le 1er tableau structuré
dest.ListObject.Resize dest.CurrentRegion 'redimensionne le tableau
With dest.ListObject.Range
    .Sort .Columns(1), xlAscending, Header:=xlYes 'tri sur la 1ère colonne
    tablo = .Value 'matrice, plus rapide
    For i = UBound(tablo) To 2 Step -1
        If tablo(i, 1) = tablo(i - 1, 1) Then tablo(i, 1) = ""
    Next
    .Columns(1) = tablo
End With
dest.ListObject.ShowTotals = True 'affiche la ligne du Total
Application.EnableEvents = True 'réactive les évènements
End Sub
C'est maintenant ce post que vous devriez cocher comme solution...

A+
 

Pièces jointes

Bonjour Job75
J'étais absent dimanche en soirée et lundi car j'ai dû m'occuper de mes petits enfants et je ne découvre vos posts que ce matin,
Pour ce qui est du marquage en résolu, je pensais qu'il fallait mettre le dernier message en tant que tel, c'est pour cela que je l'avais en post 19 qui pour moi allait devenir le dernier. Je viens donc de rectifier .
Merci pour ces remarques qui me font progresser et encore un très grand merci pour votre opiniâtreté et ce dernier tableau qui est vraiment ce que je cherchais.
J'espère à nouveau ne pas commettre trop d'impairs .
Bien cordialement et bonne journée.
 
Bonjour le forum,

Dans la macro précédente on remarquera que j'utilise CurrentRegion :
VB:
dest.ListObject.Resize dest.CurrentRegion 'redimensionne le tableau
ce qui nécessite d'isoler Tableau3 en le décalant en colonnes M N O.

Pour éviter ce décalage on peut utiliser :
VB:
Set Target = dest.EntireColumn.Find("*", , xlValues, , xlByRows, xlPrevious) 'repère la dernière ligne
dest.ListObject.Resize Range(dest.Rows(0).Resize(2), Target) 'redimensionne le tableau
Edit : ceci permet de récupérer des données situées sous des lignes vides, fichier (4 bis).

A+
 

Pièces jointes

Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

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