XL 2019 VBA moteur de recherche

philgood54000

XLDnaute Nouveau
Bonjour,

je suis à la recherche d'une aide sur mon fichier VBA moteur de recherche.
En quelques mots , j'ai un fichier assez important contenant des noms composés, j'ai une macro qui me permet d'aller chercher le mot inscrit avec toutes les correspondances liés à ma recherche.
ce que je souhaiterai avoir c'est que ma recherche ne sorte que le mot recherché exactement ( pour exemple : je cherche Martin, il me sort Martint, Martinet, Martins, etc...)

je mets la macro utilisé

Dim tab_mots() As String
Dim compteur As Byte
Dim ligne As Long: Dim ligne_ext As Long
Dim valider As Boolean
Dim ann As String: Dim dat As String
Dim marq As String: Dim pat As String
Dim chaine As String
purger
tab_mots = Split(Range("B2").Value, " ")
ligne = 2: ligne_ext = 6

While Sheets("Base 2021 2022").Cells(ligne, 2).Value <> ""
valider = True

ann = Sheets("TDB").Cells(ligne, 1).Value
dat = Sheets("TDB").Cells(ligne, 2).Value
marq = Sheets("TDB").Cells(ligne, 3).Value
pat = Sheets("TBD").Cells(ligne, 14).Value

chaine = ann & "-" & dat & "-" & marq & "-" & pat

For compteur = 0 To UBound(tab_mots())
If (Len(tab_mots(compteur)) > 3) Then
If (InStr(1, sansAccent(chaine), sansAccent(tab_mots(compteur)), vbTextCompare) = 0) Then
valider = False
Exit For
End If
End If
Next compteur
If (valider = True) Then
Cells(ligne_ext, 1).Value = ann
Cells(ligne_ext, 2).Value = dat
Cells(ligne_ext, 3).Value = marq
Cells(ligne_ext, 7).Value = pat

ligne_ext = ligne_ext + 1

End If
ligne = ligne + 1
Wend
Cells(1, 1).Select
End Sub

Merci d'avance pour votre aide .
 
C

Compte Supprimé 979

Guest
Bonjour le nouveau et bienvenue

Pour une lecture plus facile il est de rigueur de mettre le code donné entre balises
et donc d'utiliser le bouton prévu à cet effet 🧐
1688687107571.png

A+
 

philgood54000

XLDnaute Nouveau
VB:
Bonjour le nouveau et bienvenue

Pour une lecture plus facile il est de rigueur de mettre le code donné entre balises
et donc d'utiliser le bouton prévu à cet effet 🧐
Regarde la pièce jointe 1174103
A+
Bonjour, merci pour la réponse et surtout des conseils, comme c'est la premeire fois , merci pour votre compréhension.
A l'avenir j'essayerai d'etre vigilent, mais il se peut que je fasse encore quelques erreurs !:)
J'espere que vous m'en tiendrez pas rigueur.
A +
 

cp4

XLDnaute Barbatruc

Oneida

XLDnaute Impliqué
Bonjour, a tous,

Un exemple de code recherche

@philgood54000:​

VB:
Sub Recherche_Nom()
    Dim Plage_Nom As Range
    Dim Lig As Long, Nom_Exist As Long, n As Long
    Dim Nom As String
   
    Nom = Worksheets("Rechercher").Range("B2")
    Nom_Exist = Application.CountIf(Range("Tableau1[Patronyme]"), Nom)   'nombre de fois ce qui est recherche
   
    If Nom_Exist > 0 Then
        Set Plage_Nom = Range("Tableau1[Patronyme]")     'mise en memoire colonne Patronyme
        Lig = 1
        'boucle sur le nombre de ligne avec le nom recherche
        For n = 1 To Nom_Exist
            Lig = Plage_Nom.Find(Nom, lookat:=xlWhole).Row      'recherche ligne du nom
            ' code pour ecrire ou vous voulez
            '
            '
            '
        Next n
    Else
        MsgBox ("Attention: ce nom " & Nom & " n'est pas dans la liste!!")
    End If
    Set Plage_Nom=Nothing
End Sub
 

philgood54000

XLDnaute Nouveau
Bonjour,

Je ne vois aucun nom composé. Es-tu sûr d'avoir joint le bon fichier?
Tu as des noms en doublons, que faut-il faire exactement?
Bonne journée.
Bonjour, je te renvoie le fichier avec noms composés, ce que je cherche c'est de trouver dans l'onglet rechercher cellule B2 le nom exact, par exemple si j'inscris "martin" je veux juste la correspondance exacte avec le fichier il me sort tous les "martin" c'est à dire toute la liste de l'onglet "base 2021 2022"

merci pour ton aide
 

Pièces jointes

  • Test.xlsx
    28.2 KB · Affichages: 8

cp4

XLDnaute Barbatruc
Bonjour, je te renvoie le fichier avec noms composés, ce que je cherche c'est de trouver dans l'onglet rechercher cellule B2 le nom exact, par exemple si j'inscris "martin" je veux juste la correspondance exacte avec le fichier il me sort tous les "martin" c'est à dire toute la liste de l'onglet "base 2021 2022"

merci pour ton aide
Bonjour @philgood54000 , @BrunoM45 , @Oneida

@philgood54000 : Je ne comprends pas ce que tu veux exactement (le code de oneida est bon?! ).
Par exemple, tu as 3 lignes avec "Martinet david" quel est l'autre critère pour différencier les 3 lignes,
plus que tu n'en veux qu'un "Martinet david".

Ensuite, tu joins un fichier xlsx alors que parle de code. Tu as édité un code incomplet (appel à d'autres procédures).
Bon dimanche.
 

Oneida

XLDnaute Impliqué
Bonjour @philgood54000 , @BrunoM45 , @Oneida

@philgood54000 : Je ne comprends pas ce que tu veux exactement (le code de oneida est bon?! ).
Par exemple, tu as 3 lignes avec "Martinet david" quel est l'autre critère pour différencier les 3 lignes,
plus que tu n'en veux qu'un "Martinet david".

Ensuite, tu joins un fichier xlsx alors que parle de code. Tu as édité un code incomplet (appel à d'autres procédures).
Bon dimanche.
Bonjour,
Ca roule?
Mon code ne convient pas avec plusieurs infos dans la meme cellule. Il faut tester si le nom cherche est contenu dans la cellule
 

Oneida

XLDnaute Impliqué

philgood54000​

Une facon de faire, a vous de modifier pour ecrire les quatre infos dans Rechercher.
Si vous aviez mis un fichier avec les dites infos, ca aurait ete mieux.
Les donnees dans Base sont dans un tableau ou pas?
 

Pièces jointes

  • Test_Nom.xlsm
    43 KB · Affichages: 1

job75

XLDnaute Barbatruc
Bonjour philgood54000, Oneida, cp4,

Il faut trouver les mots avec la correspondance exacte :
VB:
Sub Rechercher()
Dim cible$, tablo, resu(), i&, s, j%, n&
cible = CStr([B2])
tablo = [Tableau1].Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
ReDim resu(1 To UBound(tablo), 1 To 1)
For i = 1 To UBound(tablo)
    s = Split(tablo(i, 1)) 'séparateur espace
    For j = 0 To UBound(s)
        If s(j) = cible Then
            n = n + 1
            resu(n, 1) = tablo(i, 1)
            Exit For
        End If
Next j, i
'---restitution---
With [A6] '1ère cellule de destination
    If n Then .Resize(n) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1).ClearContents 'RAZ en dessous
End With
End Sub

Sub RAZ()
Range("B2,A6:A" & Rows.Count) = ""
End Sub
A+
 

Pièces jointes

  • Test.xlsm
    36.4 KB · Affichages: 6

Statistiques des forums

Discussions
312 210
Messages
2 086 279
Membres
103 170
dernier inscrit
HASSEN@45