XL 2010 listes et dépendances

[poipoi]

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à...

 

[job75]

On peut utiliser le filtre avancé, c'est plus simple et probablement plus rapide :

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

 

[job75]

J'ai mesuré les durées d'exécution des macros :

- post #15 => 3,3 centièmes de seconde

- post #16 => 0,25 centième de seconde, avec le filtre avancé c'est 13 fois plus rapide.

 

[job75]

Notez qu'avec le filtre avancé la 7ème ligne de la macro (RAZ) est inutile et peut être supprimée.

 

[poipoi]

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.

 

[job75]

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).

 

[job75]

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 :

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+

 

[poipoi]

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.

 

[job75]

Bonjour le forum,

Dans la macro précédente on remarquera que j'utilise CurrentRegion :

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 :

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+