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 :
Recherche à résultat mutliple dans un tableau de données à 2 entrées :
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()) :
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()) :
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
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
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 =
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
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) =
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
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
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
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
Dernière édition:
...mais ne faudrait-il pas joindre un petit fichier permettant, notamment à une personne de niveau non-avancé, d'en saisir l'utilité plus directement ?
