Recherchev, VBE, recherchev polyvalente

Option Explicit

'RD =cellule où commencer la recherche
'RC = cellule critère
'RDT = cellule où cherche la donnée
'Ligne rechercher jusque ligne... (optional) si 0 cherche jusqu'au bout de la ligne

Public Function RechercheVmulti(RD As Range, RC As Range, RDT As Range, _
            Optional Ligne As Long = 0)

Dim i As Integer, e As Integer, Txt As String
Dim LigE As Long, ColE As Long 'où écrire résultats
Dim Col As Integer
Dim Lig As Long, Occ As Long
Dim FeuilE As String, FeuilRD As String, FeuilRDT As String

    On Error GoTo sortie
    LigE = Application.Caller.Row
    ColE = Application.Caller.Column
    FeuilE = Application.Caller.Parent.Name
    Application.Volatile
    Lig = RD.Row ' Ligne où commencer la recherche
    Col = RD.Column 'Colonne où commencer la recherche
    FeuilRD = RD.Parent.Name
    FeuilRDT = RDT.Parent.Name
    If Ligne = 0 Then
        Ligne = Range(Sheets(FeuilRD).Cells(65536, Col), Sheets(FeuilRD).Cells(65536, Col)).End(xlUp).Row
    End If
    'Recherche le numéro de l'occurrence à trouver
    For Occ = LigE - 1 To 1 Step -1
        Txt = Sheets(FeuilE).Cells(Occ, ColE).Formula
        If Txt = Sheets(FeuilE).Cells(LigE, ColE).Formula Then
            e = e + 1
        End If
    Next Occ
    For i = Lig To Ligne
        If Sheets(FeuilRD).Cells(i, Col) = RC Then
            If e <> 0 Then
                e = e - 1
            Else
                RechercheVmulti = Sheets(FeuilRDT).Cells(i, RDT.Column)
                Exit Function
            End If
        End If
    Next i
    'Si plus trouver de concordance
    RechercheVmulti = ""
Exit Function
sortie:
    'si erreur dans la formule, non détectée par Excel.
    RechercheVmulti = "#FAUTE!"
End Function

'RD =cellule où commencer la recherche
'RDT = cellule où chercher la donnée
'Ligne rechercher jusque ligne... (optional) si 0 cherche jusqu'au bout de la ligne

Public Function RechercheVmultiVide(RD As Range, RDT As Range, _
            Optional Ligne As Long = 0)

Dim i As Integer, e As Integer, Txt As String
Dim LigE As Long, ColE As Long 'où écrire résultats
Dim Col As Integer
Dim Lig As Long, Occ As Long
Dim FeuilE As Worksheet, FeuilRD As Worksheet, FeuilRDT As Worksheet

    On Error GoTo sortie
    LigE = Application.Caller.Row
    ColE = Application.Caller.Column
    Set FeuilE = Application.Caller.Parent
    Application.Volatile
    Lig = RD.Row ' Ligne où commencer la recherche
    Col = RD.Column 'Colonne où commencer la recherche
    Set FeuilRD = RD.Parent
    Set FeuilRDT = RDT.Parent
    If Ligne = 0 Then
        Ligne = Range(FeuilRD.Cells(65536, Col), FeuilRD.Cells(65536, Col)).End(xlUp).Row
    End If
    'Recherche le numéro de l'occurrence à trouver
    For Occ = LigE - 1 To 1 Step -1
        Txt = FeuilE.Cells(Occ, ColE).Formula
        If Txt = FeuilE.Cells(LigE, ColE).Formula Then
            e = e + 1
        End If
    Next Occ
    For i = Lig To Ligne
        If FeuilRD.Cells(i, Col) = "" Then 'RC Then
            If e <> 0 Then
                e = e - 1
            Else
                RechercheVmultiVide = FeuilRDT.Cells(i, RDT.Column)
                Exit Function
            End If
        End If
    Next i
    'Si plus trouvé de concordance
    RechercheVmultiVide = ""
Exit Function
sortie:
    'si erreur dans la formule, non détectée par Excel.
    RechercheVmultiVide = "#FAUTE!"
End Function

If Sheets(FeuilRD).Cells(i, Col) <> Empty Then

='Facture 1.xls'!RechercheVmulti(feuille1!$A$2;feuille2!$H$2)

'RD = Plage de cellules ou rechercher
'RC = cellule qui contient le critère
'ColRes = N°Colonne ou se trouve le résultat

Public Function RechercheDonneListe(RD As Range, RC As Range, ColRes As Integer) As String
Dim CelCou As Range
Dim ListeResult As String
    For Each CelCou In RD
        If CelCou.Value = RC.Value Then
            If ListeResult <> "" Then ListeResult = ListeResult & " , "
            ListeResult = ListeResult & Cells(CelCou.Row, ColRes)
        End If
    Next CelCou
    RechercheDonneListe = ListeResult
End Function