RechercheV Multiple

salut à tous,

le code ci dessous permet d'effectuer une rechercheV en renvoyant plusieurs résultats.

ça fonctionne très bien mais je souhaiterai le modifier mais je ne sait pas comment.

voici les 2 modifications que je souhaiterai:

la première est en rapport avec le résultat:

actuellement, si la recherche trouve plusieurs résultats, elle les renvois tous dans la même cellule avec un "separator" pour les séparer.

j'aimerai que en cas de plusieurs résultats elle me rapporte le second résultat dans la cellule situé dessous le 1er résultat et ainsi de suite...

pour la seconde modification... je ne sais pas comment l'expliquer mais la recherche ne fonctionne pas si le tableau de recherche est contenu dans un autre classeur fermé

voici le code de la fonction :

Function Recherches_Multiples(ValeurRecherchee As Range, TableDeRecherche As Range, NumColonne As Long, Separator As String) As Variant
Dim NbLignes As Long
NbLignes = TableDeRecherche.Rows.Count
Dim CompteurValeursTrouvees As Long
CompteurValeursTrouvees = 0

For i = 1 To NbLignes
If TableDeRecherche(i, 1).Value = ValeurRecherchee.Value Then
CompteurValeursTrouvees = CompteurValeursTrouvees + 1
If CompteurValeursTrouvees > 1 Then
Recherches_Multiples = Recherches_Multiples & Separator & TableDeRecherche(i, NumColonne).Value
Else
Recherches_Multiples = TableDeRecherche(i, NumColonne).Value
End If
End If
Next i
End Function

merci d'avance de votre aide

Bonjour

Si j'ai bien compris la demande : un fonction ne peut écrire dans plusieurs cellules

78chris ,

excuse moi je ne comprend pas ta réponse

RE

slygan a écrit :

j'aimerai que en cas de plusieurs résultats elle me rapporte le second résultat dans la cellule situé dessous le 1er résultat et ainsi de suite...

ah ok.

oui c'est bien ca.

si la formule renvoi plusieurs résultats j'aimerai que le second sois dans la cellule sous celle du 1er ; le 3e sous le second et ainsi de suite.

bonjour slygan,78chris,

comme ceci, mais s'il n'y a pas suffisament de cellules libres en dessous, cela vous donnera une erreur "OVERLOOP". (si vous voulez, on peut limiter cela à max 10 cellules par exemple)

Function Recherches_Multiples(ValeurRecherchee As Range, TableDeRecherche As Range, NumColonne As Long, Separator As String) As Variant
     'PS : normallement, on n'a plus besoin du "Separator" comme paramètre !!!
     Dim s

     With TableDeRecherche
          For i = 1 To .Rows.Count
               If .Cells(i, 1).Value = ValeurRecherchee.Value Then s = s & Separator & .Cells(i, NumColonne).Value
          Next i
     End With

     If Len(s) = 0 Then
          Recherches_Multiples = Array("")
     Else
          Recherches_Multiples = Application.Transpose(Split(Mid(s, 2), Separator))
     End If
End Function

Bsalv,

ta proposition ne fonctionne pas.

re,

votre fonction s'appèle pour le moment "Recherches_Multiples2", donc il faut aussi (2 fois) sauvegarder le résultat dans "Recherches_Multiples2" au lieu de "Recherches_Multiples".

et modifier "Dim s" en "Dim s as string"

RE

Cela ne fonctionne qu'avec 365 mais dans ce cas on peut utiliser Filter plutôt qu'une boucle

Function Recherche_Multiple(ValeurRecherchee As Range, TableDeRecherche As Range, NumColonne As Long) As Variant

Dim ColRes As Range, ColRech As Range

    Set ColRes = TableDeRecherche.Offset(, NumColonne - 1).Resize(, 1)
    Set ColRech = TableDeRecherche.Resize(, 1)
    With WorksheetFunction
        Recherche_Multiple = .Filter((Evaluate(ColRes.Address)), (Evaluate(ColRech.Address & "=" & ValeurRecherchee.Address)))
    End With
End Function

Mais on pourrait simplifier avec une syntaxe type RECHERCHEX

Function Recherche_Multiple2(ValeurRecherchee As Range, PlageDeRecherche As Range, PlageDeRsultat As Range) As Variant

Dim ColRes As Range, ColRech As Range

    Set ColRes = PlageDeRsultat
    Set ColRech = PlageDeRecherche
    With WorksheetFunction
        Recherche_Multiple2 = .Filter((Evaluate(ColRes.Address)), (Evaluate(ColRech.Address & "=" & ValeurRecherchee.Address)))
    End With
End Function

re,

Salut 78Chris,

Cela ne fonctionne qu'avec 365 ... ,je ne pouvais pas le vérifier dans une autre version

Une remarque, votre fonction, elle fonctionne quand la feuille active n'est pas celle de ValeurRecherchee ou TableDeRecherch ? Je ne le pense pas, mais comme on n'a pas fourni un fichier, je ne l'ai pas vérifié non plus. (Sinon, il faut aujouter "'" & .... .parent.name & "'!" & ....). Mais pourquoi choisir pour VBA dans ce cas, une formule direct dans la feuille suffit.

RE

BsAlv a écrit :

Mais pourquoi choisir pour VBA dans ce cas, une formule direct dans la feuille suffit.

C'est aussi ce que je me suis dit...

Effectivement il faut tenir compte des feuilles concernées

Bonjour à tous,

Une autre fonction (pour O365) . On tient compte des feuilles. Les fonctions sont sur Feuil1 et la table est sur Feuil2.

Function RechercheM(ByVal Valeur, Table As Range, byval Colonne As Long)
Dim t, i&, n&
   RechercheM = "": t = Table.Value
   For i = 1 To UBound(t)
      If t(i, 1) = Valeur Then n = n + 1: t(n, 1) = t(i, Colonne)
   Next i
   If n > 0 Then
      ReDim r(1 To n, 1 To 1)
      For i = 1 To n: r(i, 1) = t(i, 1): Next
      RechercheM = r
   End If
End Function

bonjour a tous,

merci a ceux qui ont essayé de m'aider.

je n'avais pas pensé a la fonction FILTRE.... effectivement cela m'apporte le résultat souhaité.

merci a vous.