VlookUp/ recherche multi résultats VBA

[bb123]

Bonjour,

J'utilise actuellement cette petite fonctions VBA qui me permet de faire une sorte de rechercheV qui me renvoie plusieurs résultats si il y en a plusieurs:

Function rmult(valcherch As Variant, x As Range, colonne As Long) As Variant

Dim u As Variant
Dim nb As Long
Dim boucle As Long

For boucle = 1 To x.Rows.Count
If x(boucle, 1) = valcherch Then
u = u & ";" & x(boucle, colonne)
nb = nb + 1
End If
Next boucle

rmult = u

End Function

C'est une fonction relativement "connue" sur les différents forum VBA.

Mon PB: je souhaiterai que chaque résultat apparaisse dans une cellule particulière plutôt que d'avoir une cellule avec tous les résultats séparés par des ";".

Je recherche la solution depuis un moment déjà, j'essaye actuellement de faire une nouvelle fonction qui utiliserai cette fonction mais sans résultat pour le moment..

Toute aide serait donc bienvenue 🙂

Merci d'avance!

 

[Modeste geedee]

Re : VlookUp/ recherche multi résultats VBA

Bonsour®

je souhaiterai que chaque résultat apparaisse dans une cellule particulière

selon l'endroit ou tu insères cette fonction.
as-tu une idée dans quelle direction l'affichage doit se faire :
cellule suivante vers le bas , vers la droite , le haut ??, la gauche ??
- quid limitation du nombre de résultats à afficher ?
- que deviennent les cellules proches : décalage(sens ?), écrasement ?
- pertinence des calculs et formules dépendantes

des solutions avec formules matricielles ont été plusieurs fois proposées,
voir discussions similaires en bas de cette page

 

[bb123]

Re : VlookUp/ recherche multi résultats VBA

Salut!
Je n'ais aucune restriction sur ou et comment doivent apparaître ces différents résultat.
Pour faire simple, disons que j'insère cette fonction dans une feuille vierge et que je souhaiterai avoir tous les résultats de ma recherche dans des cellules différentes plutôt qu'une seule comme c'est le cas.
Je vais regarder sur les discussion similaires en bas alors, voir si je trouve enfin mon bonheur!

Merci en tout cas

 

[job75]

Re : VlookUp/ recherche multi résultats VBA

Bonjour bb123, Modeste geedee,

Voyez le fichier joint et cette fonction :

Function rmult(valcherch, x As Range, colonne%)
Dim P As Range, nmax&, a(), i&, n&, t As Boolean, b()
Set x = Intersect(x, x.Parent.UsedRange) 'limitation
Set P = Application.Caller
If P.Rows.Count > 1 And P.Columns.Count > 1 Then End 'renvoie une erreur
nmax = P.Count
ReDim a(1 To nmax, 1 To 1)
For i = 1 To x.Rows.Count
  If x(i, 1) = valcherch Then
    n = n + 1
    a(n, 1) = x(i, colonne)
    If n = nmax Then Exit For
  End If
Next i
'---restitution---
t = P.Rows.Count = 1 'test
ReDim b(1 To IIf(t, 1, nmax), 1 To IIf(t, nmax, 1))
For i = 1 To nmax
  b(IIf(t, 1, i), IIf(t, i, 1)) = IIf(i > n, "", a(i, 1))
Next i
rmult = b 'vecteur ligne OU vecteur colonne
End Function

Elle renvoie un vecteur ligne ou un vecteur colonne.

Le nombre des cellules recevant les résultats peut être quelconque.

A+

 

[Modeste geedee]

Re : VlookUp/ recherche multi résultats VBA

Bonsour®
une solution sans macro... ???

voir le fichier joint

 

[bb123]

Re : VlookUp/ recherche multi résultats VBA

Merci à vous deux!!
Les deux solutions marchent nickels, c'est exactement ce dont j'avais besoin.
Je vous les piquent !!

Bonne journée,
bb123 🙂

 

[job75]

Re : VlookUp/ recherche multi résultats VBA

Bonjour bb123, Modeste geedee, le forum,

Ce code est plus logique, la plage "x" doit inclure la colonne "colonne" :

Function rmult(valcherch, x As Range, colonne%)
Dim P As Range, nmax&, a(), i&, n&, t As Boolean, b()
Set x = Intersect(x, x.Parent.UsedRange.Entirerow) 'limitation
If x Is Nothing Then rmult = "": Exit Function
Set P = Application.Caller
If Intersect(x, x.Columns(colonne)) Is Nothing Or _
  P.Rows.Count > 1 And P.Columns.Count > 1 Then rmult = [#REF!]: Exit Function
nmax = P.Count
ReDim a(1 To nmax, 1 To 1)
For i = 1 To x.Rows.Count
  If x(i, 1) = valcherch Then
    n = n + 1
    a(n, 1) = x(i, colonne)
    If n = nmax Then Exit For
  End If
Next i
'---restitution---
t = P.Rows.Count = 1 'test
ReDim b(1 To IIf(t, 1, nmax), 1 To IIf(t, nmax, 1))
For i = 1 To nmax
  b(IIf(t, 1, i), IIf(t, i, 1)) = IIf(i > n, "", a(i, 1))
Next i
rmult = b 'vecteur ligne OU vecteur colonne
End Function

Fichier (2).

A+

 

[job75]

Re : VlookUp/ recherche multi résultats VBA

Re,

Si l'on veut que la fonction fonctionne comme RECHERCHEV avec des valeurs d'erreur en colonne A ou D2 :

Function rmult(valcherch, x As Range, colonne%)
Dim P As Range, nmax&, a(), i&, n&, t As Boolean, b()
Set x = Intersect(x, x.Parent.UsedRange.EntireRow) 'limitation
If x Is Nothing Then rmult = "": Exit Function
Set P = Application.Caller
If Intersect(x, x.Columns(colonne)) Is Nothing Or _
  P.Rows.Count > 1 And P.Columns.Count > 1 Then rmult = [#REF!]: Exit Function
If IsError(valcherch) Then rmult = valcherch: Exit Function
nmax = P.Count
ReDim a(1 To nmax, 1 To 1)
For i = 1 To x.Rows.Count
  If Not IsError(x(i, 1)) Then
    If x(i, 1) = valcherch Then
      n = n + 1
      a(n, 1) = x(i, colonne)
      If n = nmax Then Exit For
    End If
  End If
Next i
'---restitution---
t = P.Rows.Count = 1 'test
ReDim b(1 To IIf(t, 1, nmax), 1 To IIf(t, nmax, 1))
For i = 1 To nmax
  b(IIf(t, 1, i), IIf(t, i, 1)) = IIf(i > n, "", a(i, 1))
Next i
rmult = b 'vecteur ligne OU vecteur colonne
End Function

Fichier (3).

A+

 

[bb123]

Re : VlookUp/ recherche multi résultats VBA

Bonjour Job75,

Merci pour ta petite fonction VBA, elle marche très bien.
Néanmoins j'aurai voulu savoir si tu pensais qu'il y avait un moyen d'obtenir le même résultat sans passer par une fonction "matricielle". J'ai des milliers de lignes dans ma base et le moindre calcul me prend trop de temps, et il se re-calcul tout le temps..!
Je ne peux pas faire un copier/collage spécial/ Valeurs car j'ai besoin que mes cellules puissent se modifier automatiquement selon ma recherche.

J'ai pensé à faire une macro qui dit quelque chose du type "Si cellule A1 du fichier XXX correspond à la valeur recherchée, alors la cellule A1 du fichier actif correspond à la cellule B1 du fichier XXX; Et ce ainsi de suite jusqu'à la fin de mon tableau"

Mais le pb, c'est que je dois relancer ma macro à chaque fois que je change l’objet de ma recherche et utiliser des fichiers externes à l'intérieur d'un code VBA, je maîtrise moyen..

Je ne sais pas si tu vois une solution ?
En espérant avoir été clair..

Merci beaucoup,

bb123/

 

[job75]

Re : VlookUp/ recherche multi résultats VBA

Bonjour bbb123,

On peut faire tout ce que vous voulez mais il faudrait déposer vos 2 fichiers.

Allégés (quelques lignes significatives suffisent) et anonymisés bien sûr.

Et montrant les résultats que vous voulez obtenir.

A+

 

[job75]

Re : VlookUp/ recherche multi résultats VBA

Re,

Bon voyez les fichiers joints et ce code :

Option Compare Text 'la casse est ignorée

Private Sub Worksheet_Change(ByVal Target As Range)
Dim fich$, valcherch, col%, v$, t, i&, n&
If Intersect(Target, [C2,C4]) Is Nothing Then Exit Sub
fich = ThisWorkbook.Path & "\Source.xlsx" 'à adapter
If Dir(fich) = "" Then MsgBox "Fichier '" & fich & "' introuvable...": Exit Sub
valcherch = [C2]: col = [C4]
v = CStr(valcherch)
Application.ScreenUpdating = False
Range("A2:A" & Rows.Count).ClearContents 'RAZ
If col < 1 Then Exit Sub
With Workbooks.Open(fich).Sheets(1) '1ère feuille
  t = .Range("A1:A2", .UsedRange).Resize(, col)
  For i = 1 To UBound(t)
    If CStr(.Cells(i, 1)) = v Then n = n + 1: t(n, 1) = .Cells(i, col)
  Next
  .Parent.Close False 'fermeture du fichier source
End With
'---restitution---
If n Then [A2].Resize(n) = Application.Index(t, , 1)
End Sub

A+

 

[BOISGONTIER]

Re : VlookUp/ recherche multi résultats VBA

Bonjour,

Fonction RechV() + rapide que Recherchev()


http://boisgontierjacques.free.fr/fichiers/Cellules/rechvJB.zip

Retour de plusieurs valeurs

http://boisgontierjacques.free.fr/fichiers/Cellules/RechVMult.zip

-Sélectionner G2:I2673
=rechvmult2(F2:F2673;matable;2)
Valider avec maj+ctrl+entrée

Function RechvMult2(clé As Range, champ As Range, colResult)
  '---- retour des occurences dans plusieurs colonnes
  Application.Volatile
  ncol = Application.Caller.Columns.Count
  Set d = CreateObject("Scripting.Dictionary")
  a = champ.Value
  b = clé.Value
  For i = LBound(a) To UBound(a)
    If d.exists(a(i, 1)) Then
      d(a(i, 1)) = d(a(i, 1)) & " : " & a(i, colResult)
    Else
      d(a(i, 1)) = a(i, colResult)
    End If
  Next i
  Dim temp()
  ReDim temp(LBound(b) To UBound(b), 1 To ncol)
  For i = LBound(b) To UBound(b)
    tmp = d(b(i, 1))
    tbl = Split(tmp, ":")
    For k = LBound(tbl) To UBound(tbl)
      If k <= ncol - 1 Then temp(i, k + 1) = tbl(k)
    Next k
  Next i
  If ncol > 1 Then RechvMult2 = temp Else RechvMult2 = Application.Transpose(temp)
End Function

Fonction Recherchev()

JB