Les fonction Recherchev(), RechercheH() et Recherche()

Accueil

Recherche d'un code
Recherche d'une valeur numérique
Jokers * et ? dans Recherchev()
Recherche d'un nombre au format texte
Recherche d'un texte numérique dans une colonne de nombres
Recherche sur une partie de code
Recherche du dernier/premier élément.
RechercheH
Recherche
Recherche vectorielle
RechercheV 2 ou plusieurs conditions
Recherchev dans plusieurs colonnes
Recherchev avec résultats multiples
Toutes les occurences dans une cellule
Recherche du dernier prix
RechercheV multi-tables
RechercheV multi-colonnes
Recherchev Indirect
RechercheV 3D
Recherchev Présentation
RechercheV commentaire
Recherchev shape
RechercheV d'une image externe
RechercheV d'une image interne
RechercheV dans un classeur ouvert variable
RechercheV dans un classeur fermé variable
Fonction personnalisée
Mail/Lien
Recherche 3D
RechercheV couleur
RechercheV avec accent
Fonction perso plus rapide que Recherchev()
Recherche multiple
Recherche d'une valeur proche
Recherche 3D VBA
Recherchev de codes > 255 caractères

Recherche d'un code

La fonction Recherchev() recherche une valeur dans la première colonne d'une table et retourne
la colonne_résultat spécifiée

La syntaxe est: RECHERCHEV(code;table;ColonneRésultat;Vrai ou faux)

Si la valeur cherchée est un code et si la table n'est PAS triée, il faut spécifier le paramètre FAUX.
On récupère #N/A si le code n'existe pas.

Sur l'exemple: RECHERCHEV(B11;Produits;2;FAUX) donne le libellé du code produit cherché

RechercheV

  • Pour afficher Inconnu si le code n'existe pas:=SI(ESTNA(RECHERCHEV(B11;Produits;2;FAUX));"Inconnu";RECHERCHEV(B11;Produits;2;FAUX))
  • Si la valeur cherchée est un code et si la table est TRIEE, on peut spécifier le paramètre VRAI.
    La recherche est alors faite par DICHOTOMIE et peut être x100 + RAPIDE puisqu'il suffit de quelques
    accés pour retrouver le code. C'est TRES IMPORTANT lorsque la table est de taille importante et que
    la formule Recherchev() est recopiée x1000 fois (Avec FAUX , Excel consulte la table SEQUENTIELLEMENT).
    Pour vérifier si le code existe (on ne récupère pas #N/A mais la valeur inférieure), il faut écrire:

    =SI(RECHERCHEV(CodeCherché;Articles;1;VRAI)=
    CodeCherché;RECHERCHEV(CodeCherché;Articles;2;VRAI);"Inconnu")

Si la table est triée par code et que le code exitse plusieurs fois, RechercheV(code;table;Col_Résultat;VRAI) positionne
sur le dernier code.

Pour récupérer plusieurs colonnes à la fois (2 et 3 par ex)

-Sélectionner C11:D11
=Recherchev(B11;Produits;{2.3};Faux)
Valider avec maj+ctrl+entrée

RechercheV Dernier

Recherche d'une valeur numérique

Avec le paramètre VRAI, Recherchev() positionne sur la valeur inférieure (la table doit être triée)

Sur l'exemple, RECHERCHEV(B8;Remise;2;VRAI) retourne le taux de remise en fonction d'un montant.

Jokers * et ? dans Recherchev()

Les jokers * et ? peuvent être utilisés dans une recherche avec Recherchev()

RechVJoker
RechvPère

Sur l'exemple, on recherche Dur (en B2)

En B3: =RECHERCHEV(B2&"*";E2:F6;2;FAUX)

Autres exemples

En F2: =RECHERCHEV(E2;BDNom;2;FAUX)

Si le champ de recherche comporte des caractères spéciaux *,? , les faire précéder du caractère ~:

=RECHERCHEV(SUBSTITUE(E2;"*";"~*");BD;2;FAUX)

RechercheV() dans une liste

RechercheVListe

Recherche d'un nombre dans une colonne de nombres au format texte

Les références de la table sont au format texte et la valeur cherchée numérique.

=RECHERCHEV(TEXTE(D2;"00000");A2:B12;2;FAUX)

Les codes de la table sont au format texte

=RECHERCHEV(TEXTE(A2;"0");E2:F5;2;FAUX)

Recherche d'un texte dans une colonne de nombres.

=RECHERCHEV(CNUM(D2);A2:B12;2;FAUX)

Autre exemple

=RECHERCHEV(CNUM(DROITE(A2;2));Produits;2;FAUX)

Recherche d'un code entier avec les derniers caractères

=RECHERCHEV("*"&D1;code;1;FAUX)

Recherchev avec positionnement sur la valeur supérieure pour une table non triée

=INDEX(C4:C7;EQUIV(MIN(SI(B4:B7>=B2;B4:B7));B4:B7;0))
Valider avec maj+ctrl+entrée

Recherche sur une partie de code

-La table contient des codes aa,bb,cc,... Le code cherché est bb rouge

Pour obtenir le prix
=INDEX(prix;EQUIV(1;EQUIV(code&"*";A2;0);0))
valider avec maj+ctrl+entrée

RechVCode

Recopie recherchev()

Pour que la formule Recherchev() soit recopiable horizontalement.

En B2:=RECHERCHEV($A2;BD;COLONNES($A:B);FAUX)

RecopieRechercheV

Recherche du dernier/premier élément

On recherche le dernier élément dans un champ

=RECHERCHEV("zzz";A2:A11;1;VRAI)

On recherche le premier élément dans un champ

=RECHERCHEV("*";A3:A11;1;FAUX)

Ci dessous, on recherche le service d'un nom.

=RECHERCHEV("zzz";DECALER($A$2;;;EQUIV(D2;noms;0));1;VRAI)

RechercheH(code;table;LigneRésultat;Vrai ou faux)

La fonction RechercheH() recherche une valeur dans la première ligne d'une table et retourne
la ligne_résultat spécifiée. -FonctionRechercheH -

Les règles sont les mêmes que pour rechercheV()

Recherche(valeur_cherchée;table)

-La recherche se fait sur la première ligne si le nombre de colonnes est > au nombre de lignes.
-La recherche se fait sur la première colonnes si le nombre de lignes est > au nombre de colonnes
-Le résultat est obtenu sur la dernière ligne ou la dernière colonne

Attention!La première ligne (ou colonne) doit être triée

Recherche(valeur_cherchée;VecteurRecherche;VecteurRésultat)

-La recherche se fait dans le premier vecteur
-Le résultat est obtenu dans le second vecteur

Recherche de la valeur supérieure dans une table non triée

=MIN(SI(B4:B7>=B2;B4:B7))
Valider avec Maj+ctrl+entrée

Recherche du dernier nombre/dernière chaîne d'un champ

=RECHERCHE(9^9;A2:A15)
=RECHERCHE("zz";A2:A15)

Recherche de la valeur la plus proche

Recherchev() positionne sur la valeur inférieure. Ici, on obtient la valeur la + proche (inférieure ou supérieure)

=MIN(SI(MIN(ABS(valeur-A2))=ABS(valeur-A2);result))
Valider avec Maj+Ctrl+entrée

PlusProche

Recherchev suivant 2 conditions

On fait une recherche sur 2 critères (Nom+ Prénom)

=INDEX(Villes;EQUIV(1;(Noms=F2)*(Prénoms=G2);0))
valider avec Maj+Ctrl+entrée

ou
=INDEX(Villes;EQUIV(F2&" "&G2;Noms&" "&Prénoms;0))
valider avec Maj+Ctrl+entrée

Remarques
-
Sommeprod() ne permet pas de récupérer une valeur Alpha.
-La formule =BDLIRE(A1:C10;"ville";F1:G2) donnerait le même résultat mais plus rapidement.

RecherchePlusieursConditions

Autre exemple

On recherche un tarif en fonction d'un article et du poids.

=INDEX(tarif;EQUIV(1;(article=A2)*(poids>=B2);0))
Valider avec Maj+Ctrl+entrée

Autre exemple

On cherche le temps mini pour un club et une catégorie:

=MIN(SI((Club=H2)*(Cat=I2);temps))
=INDEX(nom;EQUIV(1;(Club=H2)*(Cat=I2)*(temps=H6);0))

Recherchev dans plusieurs colonnes

-Recherche le numéro de ligne d'un mot dans un champ
-Donne la valeur associée dans une autre table

=INDEX(resultat;MAX(SI(champ=G2;LIGNE(INDIRECT("1:"&LIGNES(champ))))))
Valider avec Maj+ctrl+entrée

Recherche Mot Champ
Recherche Mot Champ2

Si le mot existe plusieurs fois, pour obtenir toutes les lignes de résultat

=SI(LIGNES($1:1)<=NB.SI(champ;$G$2);INDEX(resultat;
PETITE.VALEUR(SI(champ=$G$2;LIGNE(INDIRECT("1:"&LIGNES(champ))));LIGNES($1:1)));"")
Valider avec Maj+ctrl+entrée

Avec une fonction personnalisée

=rechvMultiCol(G2;champ;resultat)

Function rechvMultiCol(mot As Range, champRecherche As Range, champRésultat As Range)
  a = champRecherche
  rechvMultiCol = ""
  For i = LBound(a) To UBound(a)
    For j = LBound(a, 2) To UBound(a, 2)
       If a(i, j) = mot Then rechvMultiCol = champRésultat(i): Exit Function
    Next j
  Next i
End Function

Recherchev avec résultats multiples

On recherche toutes les valeurs associées à un code.

-Sélectionner E9
=SI(LIGNES($1:1)<=NB.SI(Code;$E$6);INDEX(result;PETITE.VALEUR(SI(Code=$E$6;LIGNE(INDIRECT("1:"&LIGNES(Code))));LIGNES($1:1)));"")
-Valider avec Maj+Ctrl+Entrée

Recherche tous texte
Recherche Tous Num
Recherche tous texte horizontal
Recherche tous hrizontal partiel

Le dernier: =INDEX(result;MAX(SI(Code=E6;LIGNE(INDIRECT("1:"&LIGNES(Code)));0)))

Le 2e : =INDEX(result;PETITE.VALEUR(SI(Code=E6;LIGNE(INDIRECT("1:"&LIGNES(Code))));2))

Si la table est triée

En E9: =SI(LIGNES($1:1)<=NB.SI(Code;$E$6);INDEX(result;EQUIV($E$6;Code;0)+LIGNES($1:1)-1;0);"")

Avec 2 conditions

-Sélectionner F9
=SI(LIGNES($1:1)<=SOMMEPROD((code1=$F$6)*(code2=$G$6));
INDEX(Resultat;PETITE.VALEUR(SI((code1=$F$6)*(code2=$G$6);LIGNE(INDIRECT("1:"&LIGNES(code1))));LIGNES($1:1)));"")
-Valider avec Maj+Ctrl+Entrée

Recherche tous texte2Cond

Le premier:=INDEX(Resultat;EQUIV(1;(code1=F7)*(code2=G7);0))
Le dernier:=INDEX(Resultat;MAX(SI((code1=$F$7)*(code2=$G$7);LIGNE(INDIRECT("1:"&LIGNES(code1))))))
Le 2e: =INDEX(Resultat;PETITE.VALEUR(SI((code1=$F$7)*(code2=$G$7);LIGNE(INDIRECT("1:"&LIGNES(code1))));2))

Autre exemple

On cherche les numéros de tph pour une chambre(F2).

ListeCond

En H2:
=SI(LIGNES($1:1)<=NB.SI(CHAMBRE;$F$2&"*");
INDEX(TPH;PETITE.VALEUR(SI(GAUCHE(CHAMBRE;3)=TEXTE($F$2;"000");LIGNE(INDIRECT("1:"&LIGNES(CHAMBRE))));LIGNES($1:1)));"")
Valider avec Maj+ctrl+entrée

Toutes les occurences dans une seule cellule

Donne toutes les occurences correspondant à une valeur cherchée. Sur l'exemple, on recherche les fêtes à souhaiter pour un jour.

RechercheTous

Function RechTous(v, champRech As Range, ChampRetour As Range, separateur)
  a = champRech
  temp = ""
  For i = 1 To champRech.Count
    If a(i, 1) = v Then
        temp = temp & ChampRetour(i) & separateur
    End If
  Next i
  RechTous = Left(temp, Len(temp) - 1)
End Function

Recherche le dernier

=INDEX(Prix;MAX(SI((produit=A2);LIGNE(INDIRECT("1:"&LIGNES(produit))))))
Valider avec maj+ctrl+entrée

Dernier

Si la table est triée par produit

=INDEX(Prix;EQUIV(A2;produit;0)+NB.SI(produit;A2)-1)
ou
=RECHERCHEV(A2;Tbl;2;VRAI)

Recherche du dernier prix (pour la dernière date)

On veut le dernier prix d'achat pour un produit

Les dates d'achat pour chaque produit sont dans l'ordre croissant:

Date dernier achat: =SI(NB.SI(produit;A2);MAX(SI((produit=A2);date));"") Valider avec Maj+ctrl+entrée
Prix: =SI(NB.SI(produit;A2);INDEX(Prix;MAX(SI(produit=A2;LIGNE(INDIRECT("1:"&LIGNES(produit)));0)));"")

Les dates pour chaque produit ne sont pas dans l'ordre croissant et Il n'y a qu'un prix par jour pour chaque produit

Date dernier achat : =SI(NB.SI(produit;A2);MAX(SI((produit=A2);date));"")
Prix: =SI(NB.SI(produit;A2);INDEX(Prix;EQUIV(1;(MAX((produit=A2)*date)=date)*(produit=A2);0));"")

DernierPrix
RechercheDernier

RechercheV multi-tables

On recherche un code dans plusieurs tables nommées Renault,Peugeot,Citroën.
Les tables peuvent être sur des feuilles différentes.

Recherche multi-tables classique

=SI(NON(ESTNA(RECHERCHEV(A2;renault;2;FAUX)));RECHERCHEV(A2;renault;2;FAUX);
SI(NON(ESTNA(RECHERCHEV(A2;citroen;2;FAUX)));RECHERCHEV(A2;citroen;2;FAUX);
SI(NON(ESTNA(RECHERCHEV(A2;peugeot;2;FAUX)));RECHERCHEV(A2;peugeot;2;FAUX);"Inc")))

RechercheVMultiTables

Recherche multi-tables avec formule matricielle

On recherche un code dans plusieurs tables nommées Renault,Peugeot,Citroën.
Les tables peuvent être sur des feuilles différentes.
nz est un champ qui contient les noms des tables.

Libellé
=RECHERCHEV(A2;INDIRECT(INDEX(nz;EQUIV(VRAI;(NB.SI(INDIRECT(nz);A2)>0);0)));2;FAUX)
Valider avec maj+ctrl+entrée

Nom de la table contenant le code cherché
=INDEX(nz;EQUIV(VRAI;(NB.SI(INDIRECT(nz);A2)>0);0))
Valider avec maj+ctrl+entrée

RechercheVMZ

Si les noms de champ sont génériques Zone1,Zone2,Zone3
=RECHERCHEV(A2;INDIRECT("zone"&EQUIV(VRAI;(NB.SI(INDIRECT("zone"&LIGNE(1:3));A2)>0);0));2;FAUX)
Valider avec maj+ctrl+entrée

Pour limiter la recherche à la zone des codes
Nommer citroen $H$12:$H$18, peugeot $D$19:$D$23, renault $C$10:$C$14

=RECHERCHEV(A2;DECALER(INDIRECT(INDEX(nz;EQUIV(VRAI;(NB.SI(INDIRECT(nz);A2)>0));0));;;;2);2;FAUX)
Valider avec maj+ctrl+entrée

ou

=INDEX(DECALER(INDIRECT(INDEX(nz;EQUIV(VRAI;(NB.SI(INDIRECT(nz);A2)>0));0));;1);
EQUIV(A2;INDIRECT(INDEX(nz;EQUIV(VRAI;(NB.SI(INDIRECT(nz);A2)>0));0));0))

RechercheV Multi-colonnes

=RECHERCHEV(A2;DECALER(code;;(EQUIV(VRAI;NB.SI(DECALER(code;;{0.1.2.3}*3);A2)>0;0)-1)*3;;3);2;0)
valider avec maj+ctrl+entrée

RechercheVMultiColonnes

Recherchev Indirect()

La table des prix est choisie en fonction du choix du pays: France,Italie,Espagne

=RECHERCHEV(A2;INDIRECT(B2);2;FAUX)

RechercheVIndirect

Recherchev 3D

Retour numérique avec feuilles génériques

Recherchev3DNum

=SOMMEPROD(SOMME.SI(INDIRECT("Feuil"&LIGNE(1:4)&"!A2:A6");$A$2;INDIRECT("Feuil"&LIGNE(1:4)&"!B2:B6")))

ou si L2:L5 contient le nom des feuilles:

=SOMMEPROD(SOMME.SI(INDIRECT("'"&L2:L5&"'!A2:A6");$A$2;INDIRECT("'"&L2:L5&"'!B2:B6")))

Retour numérique avec feuilles non génériques

Créer un nom de champ nf

=STXT(LIRE.CLASSEUR(1);TROUVE("]";LIRE.CLASSEUR(1))+1;99)&INDIRECT("iv65000")

En C2:
=SOMMEPROD(SOMME.SI(INDIRECT("'"&nf&"'!A2:A6");$B$2;INDIRECT("'"&nf&"'!B2:B6")))

Recherchev3DNumNonGenérique

Attention! La recherche se fait dans toutes les feuilles. La formule ne doit pas être dans la même colonne
que la colonne de retour (B sur l'exemple)

Retour alphanumérique avec noms de feuilles génériques

RechercheV3DAlphaNumGénérique

Si la valeur retournée est alphabétique:
=RECHERCHEV(A2;INDIRECT("feuil"&EQUIV(VRAI;(NB.SI(INDIRECT("Feuil"&LIGNE(1:4)&"!A2:B6");A2)>0);0)&"!A2:B6");2;FAUX)
valider avec Maj+Ctrl+entrée

Nom de la feuille qui contient la valeur recherchée:
="Feuil"&EQUIV(VRAI;(NB.SI(INDIRECT("Feuil"&LIGNE(1:4)&"!A2:A6");A2)>0);0)

Pour détecter si la valeur cherchée n'existe pas:
=SI(ESTNA(EQUIV(VRAI;(NB.SI(INDIRECT("Feuil"&LIGNE(1:4)&"!A2:B6");A2)>0);0));"Inc";RECHERCHEV(A2;
INDIRECT("feuil"&EQUIV(VRAI;(NB.SI(INDIRECT("Feuil"&LIGNE(1:4)&"!A2:B6");A2)>0);0)&"!A2:B6");2;FAUX))

Si le nombre de feuilles est variable
Créer un nom de champ: NbFeuilles =LIRE.CLASSEUR(4)&INDIRECT("iv65000")

=RECHERCHEV(A9;INDIRECT("feuil"&EQUIV(VRAI;(NB.SI(INDIRECT("Feuil"&
LIGNE(INDIRECT("1:"&NbFeuilles))&"!A2:B6");A9)>0);0)&"!A2:B6");2;FAUX)
valider avec Maj+Ctrl+entrée

Retour alphanumérique avec noms de feuilles non génériques

Si les noms des feuilles sont en J2:J5

RechercheV3DAlphaNumNonGénérique

=RECHERCHEV(A2;INDIRECT("'"&INDEX(J2:J5;EQUIV(VRAI;(NB.SI(INDIRECT("'"&J2:J5&"'!A2:A6");A2)>0);0))&"'!A2:B6");2;0)
Valider avec Maj+ctrl+entrée

Nom de la feuille qui contient la valeur recherchée:
=INDEX(J2:J5;EQUIV(VRAI;(NB.SI(INDIRECT("'"&J2:J5&"'!A2:A6");A2)>0);0))
Valider avec maj+ctrl+entrée

Sans noms de feuilles dans la feuille

Créer un nom de champ
nf =STXT(LIRE.CLASSEUR(1);TROUVE("]";LIRE.CLASSEUR(1))+1;99)&INDIRECT("iv65000")

=RECHERCHEV(A2;INDIRECT(INDEX(nf;EQUIV(VRAI;(NB.SI(INDIRECT(nf&"!A2:B100");A2)>0);0))&"!A2:B100");2;FAUX)
valider avec maj+ctrl+entrée

RechercheV3DAlphANumNonGénérique4
RechercheV3DAlphANumNonGénérique3
Recherchev3DBis
Recherchev3DTer
Recherchev3D4

Si données sont dans un autre classeur ouvert [article.xls] et les noms des feuilles dans un champ nommé 'nf'

=RECHERCHEV(A2;INDIRECT(INDEX("[article.xls]"&nf;EQUIV(VRAI;(NB.SI(INDIRECT("[article.xls]"&nf&"!A2:A100");A2)>0);0))&
"!A2:C100");2;0)

Recherchev avec mise en forme

On récupère le libellé du produit ainsi que la couleur.

RechercheVCouleur
RechercheVComment

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect([A2:A10], Target) Is Nothing And Target.Count = 1 Then
     p = Application.Match(Target, Application.Index([data], , 1), 0)
     If Not IsError(p) Then  Sheets("BD").Range("data").Cells(p, 2).Copy Target.Offset(, 1)
  End If
End Sub

Private Sub Worksheet_Activate() ' pour maj si changement dans la BD
  Application.ScreenUpdating = False
  For Each c In [A2:A10]
     p = Application.Match(c, Application.Index([data], , 1), 0)
     If Not IsError(p) Then  Sheets("BD").Range("data").Cells(p, 2).Copy c.Offset(, 1)
   Next c
   Application.ScreenUpdating = True
End Sub

Autre exemple

On récupère la présentation et le commentaire.
Si la mise en forme de la base est modifiée, la mise en forme du résultat est modifiée.

RechercheVPrésentation


Dans l'onglet Descriptif

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 1 And Target.Count = 1 Then
    p = Application.Match(Target, Application.Index([données], , 1), 0)
    If Not IsError(p) Then
       Sheets("BD").Range("données").Cells(p, 2).Copy Target.Offset(, 1)
    End If
  End If
End Sub

Private Sub Worksheet_Activate()
  Application.ScreenUpdating = False
  For Each c In [A3:A10]
    p = Application.Match(c, Application.Index([données], , 1), 0)
    If Not IsError(p) Then
       Sheets("BD").Range("données").Cells(p, 2).Copy c.Offset(, 1)
    End If
  Next c
  Application.ScreenUpdating = True
End Sub

Recherchev commentaire

On récupère les informations d'un client dans un commentaire.

RecherchevCommentaire

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 5 And Target.Count = 1 Then
    Dim pos(1 To 11)
    Target.ClearComments
    p = Application.Match(Target, Application.Index([clients], , 1), 0)
    If Not IsError(p) Then
       pos(1) = 1
       For i = 2 To 11
          tmp = tmp & [titre].Cells(1, i) & ":" & [clients].Cells(p, i) & vbLf
          pos(i) = pos(i - 1) + Len([titre].Cells(1, i)) + Len([clients].Cells(p, i)) + 2
       Next i
       Target.AddComment Text:=tmp
       Target.Comment.Shape.TextFrame.AutoSize = True
       For i = 1 To 11
         With Target.Comment.Shape.TextFrame.Characters(Start:=pos(i), _
            Length:=Len([titre].Cells(1, i + 1))).Font
           .Name = "Verdana"
           .Size = 8
           .Bold = True
          End With
       Next i
       Target.Comment.Shape.TextFrame.Characters(Start:=pos(6) + Len([titre].Cells(1, 6)) + 2, _
        Length:=Len([clients].Cells(p, 6))).Font.ColorIndex = 3
    End If
  End If
End Sub

Recherchev Shape

Affiche la fiche client du client sélectionné.

-Définir un modèle de fiche en O2:P12
-Créer un shape MonShape avec l'appareil photo.

Cliquer sur le nom du client.

RechercheVShape

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Column = 5 And Target.Count = 1 Then
    p = Application.Match(Target, Application.Index([clients], , 1), 0)
    If Not IsError(p) Then
      ActiveSheet.Shapes("monShape").Visible = True
      For i = 1 To 11
        Cells(i + 1, 16) = [clients].Cells(p, i)
      Next i
      Shapes("monshape").Left = Target.Offset(, 1).Left + 5
      Shapes("monshape").Top = Target.Top
    Else
      ActiveSheet.Shapes("monShape").Visible = False
    End If
  End If
End Sub

Recherchev d'une image externe

Si les images sont dans le même répertoire que le classeur

En B2: =afficheimage(A2&".jpg")

Si les images sont dans le répertoire c:\mesdoc\

En B2: =afficheImage(A2&".jpg";"c:\mesdoc\")

AfficheImage

Function AfficheImage(NomImage, Optional rep As String)
  Application.Volatile
  If IsMissing(rep) Then rep = ThisWorkbook.Path & "\"
  Set adr = Application.Caller
  temp = NomImage & "_" & adr.Address
  Existe = False
  For Each s In adr.Worksheet.Shapes
     If s.Name = temp Then Existe = True
  Next s
  If Not Existe Then
     For Each k In adr.Worksheet.Shapes
        p = InStr(k.Name, "_")
        If Mid(k.Name, p + 1) = adr.Address Then k.Delete
     Next k
     Set s = adr.Worksheet.Shapes.AddPicture(rep & NomImage, True, True, adr.Left, adr.Top, adr.Width,         adr.Height)
     s.Name = NomImage & "_" & adr.Address
  End If
End Function

Recherchev d'une image interne

AfficheImageInterne

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 3 And Target.Count = 1 Then
    '-- suppression
    For Each s In ActiveSheet.Shapes
      If s.Type = 6 Or s.Type = 9 Then
         If s.TopLeftCell.Address = Target.Offset(0, 1).Address Then s.Delete
      End If
    Next s
    '--
    If Target <> "" Then
       lig = [noms].Find(Target, LookAt:=xlWhole).Row
       col = [noms].Column + 3
       For Each s In Sheets("Feuil1").Shapes
          If s.TopLeftCell.Address = Cells(lig, col).Address Then s.Copy
       Next s
       Target.Offset(0, 3).Select
       ActiveSheet.Paste
       Selection.ShapeRange.Left = ActiveCell.Left + 7
       Selection.ShapeRange.Top = ActiveCell.Top + 5
       Target.Select
     End If
   End If
End Sub

Recherchev avec classeur ouvert variable

En B4:=RECHERCHEV(A4;INDIRECT("["&$B$1&".xls]BD!$A$2:$B$8");2;FAUX)

Si en B1, on a la semaine 45 , la formule devient :

=RECHERCHEV(A4;INDIRECT("[Sem"&$B$1&".xls]BD!$A$2:$B$8");2;FAUX)

RechercheVclasseurOuvert
Sem45

Recherchev avec classeur fermé variable

Les données sont dans les classeurs fermés Sem1,Sem2,..,Sem45,..
Le code VBA génère la formule en fonction du nom de fichier saisi en B2.

Formule générée pour l'exemple
=RECHERCHEV(A5;'C:\mesdoc\[Sem45.xls]BD'!$A$2:$B$8;2;FAUX)

RechercheVclasseurFermé


Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$B$2" Then
    répertoire = [A2]
    fichier = [B2]
    temp = "=vlookup(A5,'" & répertoire & "\[" & [B2] & ".xls]BD'!$A$2:$B$8,2,false)"
    [B5].Formula = temp
   [B5].AutoFill Destination:=[B5].Resize(4), Type:=xlFillDefault
  End If
End Sub

Autre exemple de rechercheV() dans un classeur fermé variable

Le chemin du fichier et le fichier sont variables. Le fichier est fermé.
La formule RechercheV() est écrite dynamiquement à chaque fois que le chemin ou le fichier sont modifiés.
La table de recherche dans le classeur fermé est nommée Produit.

RechercheVDynamique

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$F$2" Or Target.Address = "$F$5" And Target.Count = 1 Then
    If [F2] <> "" And [F5] <> "" Then
       ChampFormule = "C2:C4"
       chemin = Range("F2")
       fichier = Range("F5")
       NomTableRecherche = "produit" ' nom du champ
       If Dir(chemin & "\" & fichier) <> "" Then
          Range(ChampFormule).Formula= _
            "=VLOOKUP(B2," & "'" & chemin & "\" & fichier & "'!" & NomTableRecherche & ",2,false)"
       Else
           MsgBox "fichier inconnu"
       End If
    End If
  End If
End Sub

Si la table de recherche dans le classeur fermé n'est pas nommée:

Range(ChampFormule).Formula = _
"=VLOOKUP(B2," & "'" & chemin & "\[" & fichier & "]Janvier'!$D$2:$E$5" & ",2,false)"

Avec Equiv/Index:

Range(ChampFormule).Formula = _
"=INDEX('" & chemin & "\" & fichier & "'!" & NomTableIndex & ",MATCH(B2,'" & _
chemin & "\" & fichier & "'!" & NomTableEquiv & ",FALSE))"

Création de formules Recherchev() vers différents classeurs fermés

Dans les feuilles 44,45,46,... la macro crée des formules Recherchev() vers différents classeurs fermés SA44,SA45,SA46,...

Suivi
SA44

Sub CreeFormules()
  répertoire = ThisWorkbook.Path & "\"
  For s = 44 To 46
    nf = CStr(s)
    temp = "=vlookup(B3,'" & répertoire & "[SA" & nf & ".xls]Feuil1'!$A$2:$B$100,2,false)"
    Sheets(nf).Cells(3, 3).Formula = temp
    Sheets(nf).Cells(3, 3).AutoFill Destination:=Sheets(nf).Cells(3, 3).Resize(28), Type:=xlFillDefault
  Next s
End Sub

Fonction personnalisée Rechv()

Avec Recherchev(), si la table de recherche est importante (30.000 éléments) et si celle ci n'est pas triée, le temps de recalcul peut devenir long lorsque la formule est recopiée X100 fois.

La fonction personnalisée Rechv() ci dessous réduit le temps de recalcul.

-Sélectionner b2:B1000
=rechv(A2:A1000;Noms;Prenoms)
-Valider avec Maj+Ctrl+entrée

Rechv

Function rechv(champ As Range, cles As Range, valeurs As Range)
  a = cles
  b = valeurs
  c = champ
  Dim d()
  Set mondico = CreateObject("Scripting.Dictionary")
  For i = 1 To cles.Count
     mondico.Add a(i, 1), b(i, 1)
  Next i
  ReDim d(1 To champ.Count)
  For i = 1 To champ.Count
  d(i) = mondico.item(c(i, 1))
  Next i
  rechv = Application.Transpose(d)
End Function

Sans formule, avec une macro

Sub essai()
  t = Timer()
  [B2:B1000] = rechv([a2:a1000], [Noms], [Prenoms])
  [c2:c1000] = rechv([a2:a1000], [Noms], [Ages])
  MsgBox Timer() - t
End Sub

Recherchev d'un mail

=LIEN_HYPERTEXTE("mailto:"&RECHERCHEV(A2;Noms;2;FAUX);RECHERCHEV(A2;Noms;2;FAUX))

Pour un lien:

=LIEN_HYPERTEXTE(RECHERCHEV(A2;Noms;2;FAUX);RECHERCHEV(A2;Noms;2;FAUX))

Récupération d'une cellule d'un classeur fermé variable

RecupClasseurFermé

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$B$2" Then
    Chemin = ThisWorkbook.Path
    Fichier = [B2]
    [B5].Formula = "='" & Chemin & "\[" & Fichier & "]Feuil1'!B15"
    [B5].Value = [B5].Value
  End If
End Sub

Récupération d'un champ d'un classeur fermé variable

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$B$2" Then
     ChampOuCopier = "A5:B16"
     Chemin = ThisWorkbook.Path
     Fichier = [B2]
     onglet = "Feuil1"
     ChampAlire = "A2:B13"
     LitChamp ChampOuCopier, Chemin, Fichier, onglet, ChampAlire
  End If
End Sub

Sub LitChamp(ChampOuCopier, Chemin, Fichier, onglet, ChampAlire)
  Range(ChampOuCopier).FormulaArray = "='" & Chemin & "\[" & Fichier & "]" & onglet & "'!" & ChampAlire
  Range(ChampOuCopier) = Range(ChampOuCopier).Value
End Sub

Recherche 3D

On recherche le nom de la feuille qui contient la date 3 janvier 2011 en C5 parmi les feuilles 01,02,03,...,31

En C6:
=SI(ESTNA(EQUIV(VRAI;(NB.SI(INDIRECT(TEXTE(LIGNE(1:31);"00")&"!G5");C$7)>0);0));"";
TEXTE(EQUIV(VRAI;(NB.SI(INDIRECT(TEXTE(LIGNE(1:31);"00")&"!G5");C$7)>0);0);"00"))
Valider avec maj+ctrl+entrée

Pour récupérer l'information en C34 de la feuille trouvée, si les noms sont au même endroit dans 01,02,….
=SI(C$6<>"";DECALER(INDIRECT(C$6&"!C34");;LIGNES($1:1)-1);0)

Si les noms ne sont pas au même endroit
=SI(C$6<>"";SOMMEPROD(SOMME.SI(INDIRECT(C$6&"!C7:P7");$B8;INDIRECT(C$6&"!C34:P34")));0)

Mat3DRecherche

Recherchev couleur

RechercheVCouleur

Function RechVCouleurFond(cel, champ)
  Application.Volatile
  RechVCouleurFond = "Inc"
  For Each c In champ
    If cel.Interior.ColorIndex = c.Interior.ColorIndex Then
      RechVCouleurFond = c.Value
    End If
Next c
End Function

Function RechVCouleurTexte(cel, champ)
  Application.Volatile
  RechVCouleurTexte = "Inc"
  For Each c In champ
    If cel.Font.ColorIndex = c.Font.ColorIndex Then
      RechVCouleurTexte = c.Value
    End If
   Next c
End Function

RechercheV avec récupération du format dans un commentaire

-Affiche le nombre dans la cellule
-Masque la cellule avec un commentaire qui contient le nombre+format
-On peut effectuer des calculs sur le résultat qui est numérique
-Si le prix est modifié dans la BD, il y a mise à jour du résultat.
-Pour accéder à la cellule, déplacer le commentaire (F9 pour le repositionner)

RechV1
RechV2
RechVJob75

Function rechV(quoi, champ, col)
  Application.Volatile
  Set f = Sheets(Application.Caller.Parent.Name)
  cel = Application.Caller.Address
  p = Application.Match(quoi, Application.Index(champ, , 1), 0)
  With f.Range(cel)
    If .Comment Is Nothing Then .AddComment
   .Comment.Shape.Width = .Width
   .Comment.Shape.Height = .Height
   .Comment.Shape.Left = .Left
   .Comment.Shape.Top = .Top
   .Comment.Visible = True
   .Comment.Text Text:=champ.Cells(p, col).Text
  End With
  rechV = champ.Cells(p, col)
End Function

RechercheV avec accent

On recherche un nom avec ou sans accent dans une table avec ou sans accent.

RechercheVAccent

Function RechvSansAccent(quoi, table As Range, colonne)
  Application.Volatile
  a = table
  For i = LBound(a) To UBound(a)
    If UCase(sansAccent(a(i, 1))) = UCase(sansAccent(quoi)) Then
      RechvSansAccent = a(i, colonne): Exit Function
    End If
  Next i
  RechvSansAccent = "inconnu"
End Function

Function sansAccent(chaine)
  codeA = "ÉÈÊËÔéèêëàçùôûïî"
  codeB = "EEEEOeeeeacuouii"
  temp = chaine
  For i = 1 To Len(temp)
    p = InStr(codeA, Mid(temp, i, 1))
    If p > 0 Then Mid(temp, i, 1) = Mid(codeB, p, 1)
  Next
  sansAccent = temp
End Function

Fonction perso RechvM() matricielle plus rapide que Recherchev() classique

Si on modifie les 2.600 valeurs cherchées dans un tableau de 20.000 items,
le temps de recalcul n'est pas visuellement mesurable (5 sec pour recherchev()).
En outre, RechvM() fonctionne également lorsque la chaîne cherchée est >255 caractères.

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

RechvM
RechvMultCol
RechvMultCol2

Function RechvM(clé As Range, champ As Range, colResult)
  Application.Volatile
  Set d = CreateObject("Scripting.Dictionary")
  a = champ.Value
  b = clé.Value
  For i = LBound(a) To UBound(a)
    d(a(i, 1)) = a(i, colResult)
  Next i
  Dim temp()
  ReDim temp(LBound(b) To UBound(b))
  For i = LBound(b) To UBound(b)
    temp(i) = d(b(i, 1))
  Next i
  RechvM = Application.Transpose(temp)
End Function

Rappel
Si la valeur cherchée est un code et si la table est TRIEE, on peut spécifier le paramètre VRAI.
La recherche est alors faite par DICHOTOMIE et peut être x100 + RAPIDE puisqu'il suffit de quelques
accés pour retrouver le code. C'est TRES IMPORTANT lorsque la table est de taille importante et que
la formule Recherchev() est recopiée x1000 fois (Avec FAUX , Excel consulte la table SEQUENTIELLEMENT).
Pour vérifier si le code existe (on ne récupère pas #N/A mais la valeur inférieure), il faut écrire:

=SI(RECHERCHEV(CodeCherché;Articles;1;VRAI)=
CodeCherché;RECHERCHEV(CodeCherché;Articles;2;VRAI);"Inconnu")

Une fonction ne peut pas retourner plus de 65.000 lignes

Le nombre de lignes dans la table où s'effectue la recherche n'est pas limité.
Si le nombre de lignes des valeurs cherchées dépasse 65.000 lignes,
utiliser ce programme qui retourne une table avec plus de 65.000 lignes.

RechvPlus65000Lignes

RechvPlus65000LignesMultCol

Sub AppelSub()
  Set TableSource = Range("A2:B1200") ' champ table source
  Set ClésCherchées = Range("I2:I68000") ' champ des clés recherchées
  Set Résultat = Range("J2:J68000") ' champ résultat
  colResult = 2
  Rechv ClésCherchées, TableSource, 2, Résultat
End Sub

Sub Rechv(ClésCherchées, TableSource, colRésult, Résultat)
  Application.ScreenUpdating = False
  Set d = CreateObject("Scripting.Dictionary")
  a = TableSource.Value ' table source
  b = ClésCherchées.Value ' table des clés recherchées
  For i = LBound(a) To UBound(a)
    d(a(i, 1)) = a(i, colRésult)
  Next i
  Dim temp()
  ReDim temp(LBound(b) To UBound(b), 1 To 1)
  For i = LBound(b) To UBound(b)
    If d(b(i, 1)) <> "" Then temp(i, 1) = d(b(i, 1)) Else temp(i, 1) = "Inconnu"
  Next i
  Résultat.Value = temp
End Sub

Recherche multiple

Sur l'exemple, on recherche plusieurs codes séparés par le caractère ",".

Function RechercheMult(couleur As String, maTable As Range)
  Application.Volatile
  a = Split(couleur, ",")
  b = maTable
  For i = LBound(a) To UBound(a)
     For j = LBound(b) To UBound(b)
        If UCase(a(i)) = UCase(b(j, 1)) Then tmp = tmp & b(j, 2) & ","
    Next j
  Next i
  If tmp <> "" Then tmp = Left(tmp, Len(tmp) - 1)
  RechercheMult = tmp
End Function

RechercheV sensible à la casse

Option Compare Binary
Function RechvCasse(clé As Range, champ As Range, colResult)
  Application.Volatile
  a = champ.Value
  b = clé.Value
  For i = LBound(a) To UBound(a)
    If clé = a(i, 1) Then RechvCasse = a(i, colResult): Exit Function
  Next i
  RechvCasse = Evaluate("na()")
End Function

Recherche d'une valeur proche

Nous recherchons Entr. de recup. dans Entreprise de récupération

Proche
Proche3
ProcheMult
Proche Société

Recherche 3D VBA

Recherche toutes les commandes d'un client dans plusieurs feuilles.

Recherche3DVBA
Recherche3D2CritèresVBA
Recherche3D2CritèresVBA2

Function cherche3D(début, fin, clé, champRecherche, champRésultat)
  Application.Volatile
  nlig = Application.Caller.Rows.Count
  ncol = Application.Caller.Columns.Count
  Dim b()
  ReDim b(1 To nlig, 1 To ncol)
  n = 0
  For s = début To fin
    Set f = Sheets(s)
    Tab1 = f.Range(champRecherche).Value
    Tab3 = f.Range(champRésultat).Value
    For lig = 1 To UBound(Tab1)
      If (UCase(Tab1(lig, 1)) = UCase(clé) Or (clé = "*" And Tab1(lig, 1) <> "")) Then
        n = n + 1: If n > nlig Then cherche3D = "Pas assez de lignes!": Exit Function
        For k = 1 To ncol: b(n, k) = Tab3(lig, k): Next k
      End If
    Next lig
  Next s
  cherche3D = b
End Function

Pédigree/Ascendants

Pédigree Ascendants

 

Recherchev lorsque le code est >255 caractères

=Rechv(A1;table;2)

Function Rechv(v, champ, col)
  Application.Volatile
  Rechv = "Inconnu"
  a = champ.Value
  For i = 1 To UBound(a)
    If v = a(i, 1) Then
      Rechv = a(i, col): Exit Function
    End If
  Next i
End Function

Recherchev multi-codes

On recherche dans une table CodesMip les libellés associés à des codes:

Code Description
ABC1 xxxxx1
ABC2 xxxxx2
ABC3 xxxxx3
ABC4 xxxxx4
ABC5 xxxxx5

-E2 contient 2 codes séparés par une virgule abc1,abc4
-La fonction =RechvMultiCodes(E2) retourne les 2 libellés séparés par une vrigule xxxxx1,xxxxx4

Recherchev Multi-codes

Function RechvMultiCodes(code)
  Application.Volatile
  codes = Split(code, ",")
  For i = LBound(codes) To UBound(codes)
    nature = Application.VLookup(codes(i), [codesMip], 2, False)
    If Not IsError(nature) Then
      tmp = tmp & nature & ","
    End If
  Next i
  If tmp <> "" Then
     RechvMultiCodes = Left(tmp, Len(tmp) - 1)
  Else
    RechvMultiCodes = ""
  End If
End Function

 

Exemples

RechercheV
Recherchev Synthèse
Index Equiv Prix
Recherchev Multi Critères
Equiv Index An Mois
Recherche Champ
Recherche tous num
Recherche tous texte
Fonctions multi-zones