Recherche & référence RECHERCHE2D

Nairolf

XLDnaute Accro
Salut le forum,

Voici mes premières fonctions personnalisées que je partage avec vous.
J'ai un peu commenté le code mais ce n'est pas trop mon fort.
Merci de vos commentaires.

Recherche d'un résultat unique (premier trouvé) dans un tableau de données à 2 entrées :
Function RECHERCHE2D(Tableau_de_recherche As Range, Valeur_cherchée_première_ligne, Valeur_cherchée_première_colonne) 'Recherche croisée première valeur exacte

Application.Volatile

Dim LigneRecherche As Range
Dim ColonneRecherche As Range
Dim RechercheLigne As Range
Dim RECHERCHE2Dolonne As Range
Dim DernièreCelluleLigne As Range
Dim DernièreCelluleColonne As Range

If Tableau_de_recherche.Columns.Count = 1 Or Tableau_de_recherche.Rows.Count = 1 Then
RECHERCHE2D = "Pb taille tableau" 'Retour du fait que le tableau doit avoir au moins 2 lignes et 2 colonnes
Else
Set LigneRecherche = Tableau_de_recherche.Resize(1, Tableau_de_recherche.Columns.Count - 1).Offset(, 1) 'Définition de la ligne dans laquelle sera cherchée "Valeur_cherchée_première_ligne"
Set ColonneRecherche = Tableau_de_recherche.Resize(Tableau_de_recherche.Rows.Count - 1, 1).Offset(1) 'Définition de la ligne dans laquelle sera cherchée "Valeur_cherchée_première_colonne"
Set DernièreCelluleLigne = LigneRecherche.Cells(LigneRecherche.Cells.Count) 'Détermine la dernière cellule de la plage de recherche afin de démarrer la recherche à la première cellule en haut à gauche de la plage de recherche
Set DernièreCelluleColonne = ColonneRecherche.Cells(ColonneRecherche.Cells.Count) 'Détermine la dernière cellule de la plage de recherche afin de démarrer la recherche à la première cellule en haut à gauche de la plage de recherche
Set RechercheLigne = LigneRecherche.Find(Valeur_cherchée_première_ligne, LookIn:=xlValues, lookat:=xlWhole, after:=DernièreCelluleLigne) 'Rechecherche dans la ligne d'en-tête
Set RechercheColonne = ColonneRecherche.Find(Valeur_cherchée_première_colonne, LookIn:=xlValues, lookat:=xlWhole, after:=DernièreCelluleColonne) 'Recherche dans la colonne d'en-tête

If RechercheLigne Is Nothing Or RechercheColonne Is Nothing Then 'Contrôle si la recherche a donné un résultat
RECHERCHE2D = "Aucun résultat" 'Retour du fait qu'il n'y a eu aucun résultat trouvé
Else
RECHERCHE2D = Worksheets(Tableau_de_recherche.Worksheet.Name).Cells(RechercheColonne.Row, RechercheLigne.Column).Value 'Retour du premier résultat trouvé
End If

'Vidage des variables
Set DernièreCelluleLigne = Nothing
Set DernièreCelluleColonne = Nothing
Set LigneRecherche = Nothing
Set ColonneRecherche = Nothing
Set RechercheLigne = Nothing
Set RechercheColonne = Nothing
End If

End Function

Recherche à résultat mutliple dans un tableau de données à 2 entrées :
Function RECHERCHE2DM(Tableau_de_recherche As Range, Valeur_cherchée_première_ligne, Valeur_cherchée_première_colonne) 'Recherche croisée valeurs exactes multiples

Application.Volatile

Dim LigneRecherche As Range
Dim ColonneRecherche As Range
Dim RechercheLigne As Range
Dim RechercheColonne As Range
Dim tablo(), lig(), col()
Dim PremièreRechercheLigne As String
Dim PremièreRechercheColonne As String
Dim i As Integer
Dim j As Integer
Dim DernièreCelluleLigne As Range
Dim DernièreCelluleColonne As Range

If Tableau_de_recherche.Columns.Count = 1 Or Tableau_de_recherche.Rows.Count = 1 Then
RECHERCHE2DM = "Pb taille tableau" 'Retour du fait que le tableau doit avoir au moins 2 lignes et 2 colonnes
Else
Set LigneRecherche = Tableau_de_recherche.Resize(1, Tableau_de_recherche.Columns.Count - 1).Offset(, 1) 'Définition de la ligne dans laquelle sera cherchée "Valeur_cherchée_première_ligne"
Set ColonneRecherche = Tableau_de_recherche.Resize(Tableau_de_recherche.Rows.Count - 1, 1).Offset(1) 'Définition de la ligne dans laquelle sera cherchée "Valeur_cherchée_première_colonne"
Set DernièreCelluleLigne = LigneRecherche.Cells(LigneRecherche.Cells.Count) 'Détermine la dernière cellule de la plage de recherche afin de démarrer la recherche à la première cellule en haut à gauche de la plage de recherche
Set DernièreCelluleColonne = ColonneRecherche.Cells(ColonneRecherche.Cells.Count) 'Détermine la dernière cellule de la plage de recherche afin de démarrer la recherche à la première cellule en haut à gauche de la plage de recherche
Set RechercheLigne = LigneRecherche.Find(Valeur_cherchée_première_ligne, LookIn:=xlValues, lookat:=xlWhole, after:=DernièreCelluleLigne) 'Rechecherche dans la ligne d'en-tête
Set RechercheColonne = ColonneRecherche.Find(Valeur_cherchée_première_colonne, LookIn:=xlValues, lookat:=xlWhole, after:=DernièreCelluleColonne) 'Recherche dans la colonne d'en-tête

If RechercheLigne Is Nothing Or RechercheColonne Is Nothing Then 'Contrôle si la recherche a donné un résultat
RECHERCHE2DM = "Aucun résultat" 'Retour du fait qu'il n'y a eu aucun résultat trouvé
Else
'Défini une liste des numéros de colonnes à pointer
PremièreRechercheLigne = RechercheLigne.Address
ReDim Preserve lig(1 To 1)
lig(1) = RechercheLigne.Column
NbRechercheLigne = 1

Do
Set RechercheLigne = LigneRecherche.Find(Valeur_cherchée_première_ligne, RechercheLigne, xlValues)
If RechercheLigne.Address <> PremièreRechercheLigne Then
NbRechercheLigne = NbRechercheLigne + 1
ReDim Preserve lig(1 To NbRechercheLigne)
lig(NbRechercheLigne) = RechercheLigne.Column
End If
Loop Until RechercheLigne.Address = PremièreRechercheLigne

'Défini une liste des numéros de lignes à pointer
PremièreRechercheColonne = RechercheColonne.Address
ReDim Preserve col(1 To 1)
col(1) = RechercheColonne.Row
NbRechercheColonne = 1

Do
Set RechercheColonne = ColonneRecherche.Find(Valeur_cherchée_première_colonne, RechercheColonne, xlValues)
If RechercheColonne.Address <> PremièreRechercheColonne Then
NbRechercheColonne = NbRechercheColonne + 1
ReDim Preserve col(1 To NbRechercheColonne)
col(NbRechercheColonne) = RechercheColonne.Row
End If
Loop Until RechercheColonne.Address = PremièreRechercheColonne

'Cherche les valeurs croisées entre les numéros de lignes et colonnes pointées
ReDim tablo(1 To NbRechercheColonne, 1 To NbRechercheLigne)
For i = 1 To NbRechercheColonne
For j = 1 To NbRechercheLigne
tablo(i, j) = Worksheets(Tableau_de_recherche.Worksheet.Name).Cells(col(i), lig(j)).Value 'Regroupement des résultats
Next j
Next i

RECHERCHE2DM = tablo 'Retour des résultats trouvés

End If

'Vidage des variables
Set DernièreCelluleLigne = Nothing
Set DernièreCelluleColonne = Nothing
Set LigneRecherche = Nothing
Set ColonneRecherche = Nothing
Set RechercheLigne = Nothing
Set RechercheColonne = Nothing
End If

End Function

Recherche à résultat unique de la position relative (numéros de colonnes et de lignes) d'un élément (premier trouvé) dans une plage de données 2D (sur le même principe qu'EQUIV()) :
Function EQUIV2D(Valeur_cherchée, Tableau_de_recherche As Range) 'Recherche position première valeur exacte

Application.Volatile

Dim Recherche As Range
Dim tablo(0 To 1, 0 To 0)
Dim DernièreCellule As Range

Set DernièreCellule = Tableau_de_recherche.Cells(Tableau_de_recherche.Cells.Count) 'Détermine la dernière cellule de la plage de recherche afin de démarrer la recherche à la première cellule en haut à gauche de la plage de recherche
Set Recherche = Tableau_de_recherche.Find(Valeur_cherchée, LookIn:=xlValues , lookat:=xlWhole, after:=DernièreCellule) 'Rechecherche de la valeur dans le tableau

If Recherche Is Nothing Then 'Contrôle si la recherche a donné un résultat
EQUIV2D = "Aucun résultat" 'Retour du fait qu'il n'y a eu aucun résultat trouvé
Else
tablo(0, 0) = Recherche.Row - Tableau_de_recherche.Row + 1 'Détermination de la position horizontale relative
tablo(1, 0) = Recherche.Column - Tableau_de_recherche.Column + 1 'Détermination de la position verticale relative
EQUIV2D = Application.Transpose(tablo) 'Retour du résultat trouvé : Numéro Ligne et Numéro de colonne
End If

'Vidage de la variable de recherche
Set Recherche = Nothing
Set DernièreCellule = Nothing

End Function
Recherche à résultat multiple des positions relatives (numéros de colonnes et de lignes) d'un élément dans une plage de données 2D (sur le même principe qu'EQUIV()) :
Function EQUIV2DM(Valeur_cherchée, Tableau_de_recherche As Range) 'Recherche positions multiples valeurs exactes

Application.Volatile

Dim Recherche As Range
Dim Ligne_Tableau_de_recherche As Long
Dim Colonne_Tableau_de_recherche As Long
Dim tablo()
Dim DernièreCellule As Range

Set DernièreCellule = Tableau_de_recherche.Cells(Tableau_de_recherche.Cells.Count) 'Détermine la dernière cellule de la plage de recherche afin de démarrer la recherche à la première cellule en haut à gauche de la plage de recherche
Set Recherche = Tableau_de_recherche.Find(Valeur_cherchée, LookIn:=xlValues , lookat:=xlWhole, after:=DernièreCellule) 'Rechecherche de la valeur dans le tableau

If Recherche Is Nothing Then 'Contrôle si la recherche a donné un résultat
EQUIV2DM = "Aucun résultat" 'Retour du fait qu'il n'y a eu aucun résultat trouvé
Else
PremièreRecherche = Recherche.Address 'Adresse du résultat de la première recherche
Ligne_Tableau_de_recherche = Tableau_de_recherche.Row
Colonne_Tableau_de_recherche = Tableau_de_recherche.Column
ReDim tablo(1 To 2, 1 To 1)
tablo(1, 1) = Recherche.Row - Ligne_Tableau_de_recherche + 1 'Détermination de la position horizontale relative
tablo(2, 1) = Recherche.Column - Colonne_Tableau_de_recherche + 1 'Détermination de la position verticale relative
NbRecherche = 1

Do
Set Recherche = Tableau_de_recherche.Find(Valeur_cherchée, Recherche, xlValues)
If Recherche.Address <> PremièreRecherche Then
NbRecherche = NbRecherche + 1
ReDim Preserve tablo(1 To 2, 1 To NbRecherche)
tablo(1, NbRecherche) = Recherche.Row - Ligne_Tableau_de_recherche + 1 'Détermination de la position horizontale relative
tablo(2, NbRecherche) = Recherche.Column - Colonne_Tableau_de_recherche + 1 'Détermination de la position verticale relative
End If
Loop Until Recherche.Address = PremièreRecherche
EQUIV2DM = Application.Transpose(tablo) 'Retour du résultat trouvé : Numéro Ligne et Numéro de colonne
End If

'Vidage de la variable de recherche
Set Recherche = Nothing
Set DernièreCellule = Nothing

End Function

EDIT 20/04/21 15:51 :
Ajout d'un fichier exemple.
Corrections sur les codes (j'ai barré ce que j'ai supprimé et mis en gras ce que j'ai ajouté):
- Retrait d'un lien inutile vers la feuille de travail qui causait un problème de recalcul incohérent lorsqu'on modifiait un autre classeur alors que la classeur avec la fonction est ouvert.
- Ajout de l'argument "lookat" dans la méthode "Find" afin de rechercher sur l'ensemble du texte recherché et non partiellement
 

Pièces jointes

  • RECHERCHE2D.xlsm
    36.2 KB · Affichages: 45
Dernière édition:

zebanx

XLDnaute Accro
Bonjour Nairoff, le forum

@Nairoff
Nous te remercions pour tes fonctions, l'envie de les communiquer ;)...mais ne faudrait-il pas joindre un petit fichier permettant, notamment à une personne de niveau non-avancé, d'en saisir l'utilité plus directement ?
Merci.

xl-ment
zebanx
 

David Aubert

XLDnaute Barbatruc
Administrateur
Modérateur
Bonjour,

Merci beaucoup Nairolf pour le partage de tes fonctions. 👏
Pour garder une certaine lisibilité dans le forum, j'ai nommé tous tes fils en mettant uniquement le nom de la fonction en titre.
Comme tu en as mis plusieurs, tu peux soit créer un fil par fonction soit les laisser dans ton post, à toi de voir.
En tout cas il me faut un seul titre de fonction ;)
Je vais rajouter des préfixes pour catégoriser les fonctions (dans la journée) :)

Bonne journée
David
 

Nairolf

XLDnaute Accro
Salut zebanx et David,

Merci pour votre retour.

@zebanx, tu as raison je vais agrémenter ce fil avec un fichier contenant des exemples d'utilisation de ces fonctions.

@David, les 4 fonctions étant similaires, je vais les laisser dans un seul fil.
 

Nairolf

XLDnaute Accro
Salut à tous,

En creusant un peu, j'ai reproduit le fonctionnement de ma fonction RECHERCHE2DM() présente dans la feuille du même nom dans la cellule "B14".
J'ai utilisé la fonction FILTRE() qui n'est exploitable que sur les versions 365, web, Android et iOS :
Code:
=FILTRE(FILTRE($B$2:$D$5;$B$1:$D$1=$B$8);$A$2:$A$5=$B$9)
 

APg

XLDnaute Nouveau
Bonjour @Nairolf,

Donc pour se servir de tes fonctions, on doit les écrire dans VBA mais personnellement ça n'a pas fonctionné, j'ai essayé avec =ROWS(EQUIV2DM($B$8;$B$2:$D$5)) ?

Merci
 

Pièces jointes

  • Book2.xlsx
    8.5 KB · Affichages: 14

Etoto

XLDnaute Barbatruc
Re,

Mais comme on se retrouve !! Cette fonction est plus pour une feuille de calcul que pour du VBA désolé. la preuve dans son fichier joint.
 

Discussions similaires

Statistiques des forums

Discussions
315 093
Messages
2 116 125
Membres
112 666
dernier inscrit
Coco0505