XL 2016 RechercheV avec plusieurs résultats

Ethlios · 12 Mai 2022

Bonjour à tous,

Je suis à la recherche d'une formule similaire à rechercheV. Mon but est de partir d'un critère, dans mon exemple une voiture, et d'afficher toutes les possibilités de couleur liée. Dans mon tableau de donnée on trouvera donc l'information de 3 couleurs associée au critère voiture, je veux donc essayer d'avoir une formule ou une macro pouvant me sortir cette information.

Merci d'avance pour votre aide !

Ethlios.

Efgé · 14 Mai 2022

Bonjour à tous
Même si @Ethlios est sous 2016 et donc n'as pas accès aux nouvelles formules, il faut dire que 365 est quand même plus maniable pour ce genre de demande :

VB:

=JOINDRE.TEXTE("/";1;UNIQUE(FILTRE(Tableau1[Couleur];Tableau1[Type]=F9;"")))

Avec une autre version (toujours 365) dans le classeur : choix du véhicule en F9
Cordialement

sylvanu · 12 Mai 2022

Bonjour Ethlios,
Un essai en PJ avec une fonction perso :

VB:

Function RechercheMultiples(Choix$, Plage As Range)
    For i = 1 To UBound(Plage.Value2)
        If Plage.Value2(i, 1) = Choix Then RechercheMultiples = RechercheMultiples & "/" & Plage.Value2(i, 4)
    Next i
    RechercheMultiples = Mid(RechercheMultiples, 2)
End Function

La syntaxe est : =RechercheMultiples(Type;Plage) par exemple :
=RechercheMultiples(F7;$A$1:$D$14)

sylvanu · 12 Mai 2022

Re,
En beaucoup plus rapide, en passant par un array :

VB:

Function RechercheMultiple(Choix$, Plage As Range)
    T = Plage
    For i = 1 To UBound(T)
        If T(i, 1) = Choix Then RechercheMultiple = RechercheMultiple & "/" & T(i, 4)
    Next i
    RechercheMultiple = Mid(RechercheMultiple, 2)
End Function

Avec une base de 5000 références, sur mon PC, la première fonction prend 1.31s alors que la seconde prend 7.8ms.

Phil69970 · 12 Mai 2022

Bonjour @Ethlios
Bonjour Sylvain

Trop tard mais je l'ai fait je le poste quand même

Je te propose ce fichier

*Merci de ton retour

@Phil69970

Ethlios · 13 Mai 2022

Bonjour à vous deux,

Puis-je juste avoir l'explication du fonctionnement de vos macros avec des commentaires pour comprendre ?

Encore merci pour l'aide !

sylvanu · 13 Mai 2022

Bonjour Ethlios, Phil,
Quelques explications :
Function RechercheMultiple(Choix$, Plage As Range)
Déclaration de la fonction et de ses deux paramètres. Choix est le type désiré, Plage est la plage du tableau d'entrée.
T = Plage
Pour être plus rapide on transfert le tableau de cellules dans un tableau VBA ( nommé array )
For i = 1 To UBound(T)
On parcourt tout le tableau de 1 à la fin ( la fin est donnée par Ubound(T) )
If T(i, 1) = Choix Then RechercheMultiple = RechercheMultiple & "/" & T(i, 4)
Si la première cellule est égale au choix demandé, on concatène le résultat avec la cellule de la 4eme colonne soit la couleur, avec le séparateur "/"
RechercheMultiple = Mid(RechercheMultiple, 2)
Par construction la chaine à la fin commence toujours par "/" qu'il faut supprimer, donc le MID remplit la fonction. Cela correspond en XL à STXT(Chaine;2;1000)
C'est cette valeur qui est remontée dans XL car le résultat est contenu dans le nom de la fonction.

Phil69970 · 13 Mai 2022

Bonjour @Ethlios , sylvain

J'ai mis le commentaire dans la macro et le fichier joint

VB:

If Not Intersect(Target, Range("F7")) Is Nothing Then   'Sur changement cellule F7
Derlig = Feuil1.Range("A" & Rows.Count).End(xlUp).Row   'Derniere ligne colonne A
For i = 2 To Derlig                                     'Boucle sur les lignes 2 à la derniere ligne
    If Range("F7") = Range("A" & i).Value Then          'Verif si condition cellule F7 = cellule Ax
        Mem = Range("D" & i)                            'Mets dans une variable le resultat
        Mem1 = Mem1 & "/" & Mem                         'Ajoute les valeurs à la suites des autres
    End If                                              'Fin de condiion
Next i                                                  'Boucle sur la ligne suivante
[G7] = Right(Mem1, Len(Mem1) - 1)                       'Supprime le premier "/" et mets le résultat en G7

*Merci de ton retour

@Phil69970

Efgé · 14 Mai 2022

Bonjour à tous
Même si @Ethlios est sous 2016 et donc n'as pas accès aux nouvelles formules, il faut dire que 365 est quand même plus maniable pour ce genre de demande :

VB:

=JOINDRE.TEXTE("/";1;UNIQUE(FILTRE(Tableau1[Couleur];Tableau1[Type]=F9;"")))

Avec une autre version (toujours 365) dans le classeur : choix du véhicule en F9
Cordialement

Phil69970 · 14 Mai 2022

Bonjour à tous

@Ethlios

Avec ma version du post #4 / #7 il n'y a pas ce problème fonctionne sur XL 2010 - 64 Bits

Il serait bien que le demandeur se manifeste pour nous dire si une solution lui correspond.

@Phil69970

Ethlios · 16 Mai 2022

Bonjour,

Désolé pour ma réponse tardive, je n'ai pas encore eu le temps de me plonger dans vos formules, pour l'instant les 3 ne me donne aucun résultat dans mon fichier, cependant, à l'instant, je viens de sortir ma liste dans un autre Excel est la formule de @Efgé fonctionne

Ethlios

sylvanu · 16 Mai 2022

Bonjour tout le monde,
@Ethlios,
Avez vous autoriser les macros dans votre fichier ?
Car les Pj de Phil et moi utilisent des macros, alors que celle d' Efgé n'utilise que des formules.

Ethlios · 17 Mai 2022

sylvanu à dit:
Bonjour tout le monde,
@Ethlios,
Avez vous autoriser les macros dans votre fichier ?
Car les Pj de Phil et moi utilisent des macros, alors que celle d' Efgé n'utilise que des formules.

Oui bien sûr, j'ai déjà plusieurs macro sur mon fichier initial, je pense qu'il y a une coquille quelque part dans mon fichier, je ne vois que ça. Je vais essayer d'utiliser vos macros dans un nouveau fichier pour vérifier ma théorie.

Phil69970 · 17 Mai 2022

Bonjour à tous

@Ethlios
Déjà tu peux voir avec les fichiers mis à ta disposition par Sylvain et moi si cela fonctionnent chose perso que je ne doute pas car en principe quand on poste un fichier on l'a testé avant.

Donc si nos fichiers fonctionnent j'en conclu que c'est ta transposition qui pose problème.
D’où l’intérêt quand tu mets un fichier il faut qu'il soit représentatif de ton problème.
Si on demande un fichier représentatif c'est pour que la transposition soit facile et avec le moins de manipulation par le demandeur.
Exemple :
Souvent je vois un/des codes dans une feuille et retranscrit dans un module ou vice/versa par l'utilisateur.
Si on met le code dans une sub de la feuille ce n'est pas pour que l'utilisateur mette le code dans un module ou vice/versa.....

Maintenant si tu n'arrives pas à transposer le/les fichiers mis à ta disposition post un fichier "plus raccord" avec ton fichier réel.

@Phil69970

Englobe · 12 Avril 2024

sylvanu à dit:
Re,
En beaucoup plus rapide, en passant par un array :

VB:

Function RechercheMultiple(Choix$, Plage As Range) T = Plage For i = 1 To UBound(T) If T(i, 1) = Choix Then RechercheMultiple = RechercheMultiple & "/" & T(i, 4) Next i RechercheMultiple = Mid(RechercheMultiple, 2) End Function

Avec une base de 5000 références, sur mon PC, la première fonction prend 1.31s alors que la seconde prend 7.8ms.

Bonjour,
Peut-on utilisé ce code pour une recherche plutôt par couleur.
J'ai tenté avec cette modification mais le résultat renvoyé est #VALEUR.

VB:

Function RenvoiResultat(Choix As Range, Plage As Range)
    t = Plage
    c = Choix.Interior.ColorIndex
    For i = 13 To UBound(t)
        If t(i, 1).Interior.ColorIndex = c Then RenvoiResultat = RenvoiResultat & Chr(10) & t(i, 2)
    Next i
    RenvoiResultat = Mid(RenvoiResultat, 2)
End Function

Merci

sylvanu · 12 Avril 2024

Bonjour Englobe,
Un array ne peut contenir que les valeurs des cellules, pas les couleurs.
Donc il faut repasser par une analyse par cellule, par ex comme :

VB:

Function RenvoiResultat(Choix As Variant, Plage As Variant)
    c = Choix.Interior.ColorIndex
    For Each cell In Plage
        If Range(cell.Address).Interior.ColorIndex = c Then RenvoiResultat = RenvoiResultat & Chr(10) & Range(cell.Address)
    Next cell
    RenvoiResultat = Mid(RenvoiResultat, 2)
End Function

XL 2016 RechercheV avec plusieurs résultats

XLDnaute Junior

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

Discussions similaires