Recherche Multiple (RechTous) sans doublons

Bonjour à tous,

J'ai utilisé une formule que j'ai trouvé sur le site de BoisgontierJacques afin d'inscrire dans une cellule toutes les réponses d'une recherche.

Function RechTous(v, champRech As Range, ChampRetour As Range)

A = champRech

temp = ""

For i = 1 To champRech.Count

If A(i, 1) = v Then

temp = temp & ChampRetour(i) & " + "

End If

Next i

RechTous = Left(temp, Len(temp) - 1)

End Function

Cette formule est impeccable pour ce que je souhaite faire, cependant je voudrais qu'il ne m'affiche pas plusieurs fois la même valeur dans la cellule (supprimer les doublons). C'est là que j'ai besoin de votre aide. J'ai testé plusieurs trucs mais aucun ne fonctionne. Avez vous la solution à ce problème ?

Merci !

Bonjour

D'après la fonction elle va te retourner x fois le mot recherché

Pour ne retourner que le 1er mot utilises RECHERCHEV(valeur_cherchée;table_matrice;no_index_col;valeur_proche)

Pas besoin de t'embêter avec une fonction personnalisée

En gros cette fonction me sert à retrouver tout les N° de commande correspondant à 1 N° de groupage et les inscrire dans 1 seule cellule.

Hors un même numéro de commande peut être inscrit plusieurs fois dans le même N° de groupage (car plusieurs références de produits dans la commande). Donc avec cette fonction, j'ai des doublons dans la cellule destinatrice. Je voudrais rajouter un bout de maccro pour que s'il y a des doublons, elle ne m'inscrive qu'une fois la valeur.

Je sais pas si je suis assez clair...

Je vous mets un fichier exemple, ça aidera mieux à la compréhension.

Bonjour

A tester

Function RechTous(v, champRech As Range, ChampRetour As Range)

  A = champRech
  temp = ""
  For i = 1 To champRech.Count
    If A(i, 1) = v Then
      If InStr(1, temp, ChampRetour(i) & " + ") = 0 Then
        temp = temp & ChampRetour(i) & " + "
      End If
    End If
  Next i
  RechTous = Left(temp, Len(temp) - 1)

End Function

C'est nickel !!!

Merci de ta rapidité et de ton efficacité !

@+

Bonjour,

J'ai gardé la même syntaxe :

Function RechTous(v, champRech As Range, ChampRetour As Range)
    Dim dict, rech, ret
    Dim i As Long
    rech = champRech.Value
    ret = ChampRetour.Value
    Set dict = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(rech)
        If rech(i, 1) = v Then dict(ret(i, 1)) = dict(ret(i, 1)) + 1
    Next i
    dict = dict.keys
    For i = 0 To UBound(dict)
        RechTous = RechTous & ", " & dict(i)
    Next i
    RechTous = Mid(RechTous, 2)
End Function

Mais ce sont des très gros tableaux un sub sera plus rapide plutôt que d'appeler 1000 fois la fonction qui balaye 1000 fois les 1000 lignes.

eric