VBA - Recherche Find avec retour multiple

Résolu/Fermé
Mouftie Messages postés 215 Date d'inscription vendredi 28 novembre 2008 Statut Membre Dernière intervention 6 septembre 2020 - 26 mai 2017 à 10:29
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 - 27 mai 2017 à 20:46
Bonjour,
j'ai vu avec grand intérêt votre article sur les retours multiples :
https://www.commentcamarche.net/faq/18696-vba-recherche-find-avec-retour-multiple
Cependant, je voudrais renvoyé l'information d'une cellule, plutôt que l'adresse de la cellule trouvée.
Je maitrise mal les tableaux virtuels ; comment traduire Tb(i) (soit une référence sous forme $Col$Lg) en cells(1,tb(i)).
Autrement dit comment récupérer les N° de ligne dans Tb(i).
Merci de votre aide

8 réponses

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 779
26 mai 2017 à 15:05
Bonjour,

Comme ceci, en adaptant FindRech au besoin :
Sub RechMulti()
Dim R As Long, TB()
Dim i As Integer, Rch As String
Rch = 22   'par exemple
  With Sheets("Feuil1")
    .Columns(7).ClearContents ' pour les résultats
    R = RechFind(Rch, .Range("B1:E500"), 2, TB())
    If R > 0 Then
      .Range("G1") = R & " Occurences trouvées pour : " & Rch
      .Range("G2").Resize(R, 1) = Application.Transpose(TB)
    Else
      MsgBox "Non trouvé", , "Recherche"
    End If
  End With
End Sub

Function RechFind(ByVal Cle$, ByVal Plage As Range, _
                  ByVal Col&, ByRef TBval()) As Long
'Retourne toutes les valeurs trouvées dans la recherche
'Clé   = valeur cherchée
'Plage = plage à parcourir.
'Col   = colonne contenant les valeurs à retourner.
'TBval = Tableau retournant les valeurs de la colonne Col.
Dim Cherche, Ix As Long, Adr
  With Plage
    Set Cherche = .Find(Cle, , xlValues, xlWhole)
    If Not Cherche Is Nothing Then
      Adr = Cherche.Address
      Do
        ReDim Preserve TBval(Ix)
        TBval(Ix) = Plage.Parent.Cells(Cherche.Row, Col)
        Set Cherche = .FindNext(Cherche)
        Ix = Ix + 1
      Loop While Not Cherche Is Nothing And Cherche.Address <> Adr
    End If
  End With
  'nombre d'occurence(s) trouvée(s), Retour 0 si aucune occurence
  RechFind = Ix
  Set Cherche = Nothing 'Libére la mémoire occupée par l'objet.
End Function
2
Mouftie Messages postés 215 Date d'inscription vendredi 28 novembre 2008 Statut Membre Dernière intervention 6 septembre 2020 15
26 mai 2017 à 15:41
Merci beaucoup Patrice, c'est très bien.
0