Recherche mot exact

G

Gysmo

XLDnaute Junior
J'aimerais avec mon code, trouver seulement la valeur exact de ma recherche et non pas tout les dérivés.....

Merci de votre aide

Voici le code

ligne = 3
motachercher = TextBox1.Value
motachercher2 = TextBox3.Value
Sheets("feuil2").Activate
For n = 1 To Sheets("feuil2").Range("A65536").End(xlUp).Row


If InStr(1, Cells(n, 2).Value, motachercher, vbTextCompare) <> 0 And InStr(1, Cells(n, 2).Value, motachercher2, vbTextCompare) <> 0 Then


Sheets("feuil3").Range("A" & ligne) = Sheets("feuil2").Range("E" & n)
Sheets("feuil3").Range("B" & ligne) = Sheets("feuil2").Range("b" & n)
Sheets("feuil3").Range("c" & ligne) = Sheets("feuil2").Range("A" & n)
Sheets("feuil3").Range("d" & ligne) = Sheets("feuil2").Range("C" & n)
Sheets("feuil3").Range("e" & ligne) = Sheets("feuil2").Range("D" & n)
ligne = ligne + 1
End If

Next n

Unload recherche
Sheets("feuil3").Select
 
Trier par date Trier par votes
Papou-net

Papou-net

XLDnaute Barbatruc
Re : Recherche mot exact

Gysmo à dit:
J'aimerais avec mon code, trouver seulement la valeur exact de ma recherche et non pas tout les dérivés.....

Merci de votre aide

Voici le code

ligne = 3
motachercher = TextBox1.Value
motachercher2 = TextBox3.Value
Sheets("feuil2").Activate
For n = 1 To Sheets("feuil2").Range("A65536").End(xlUp).Row


If InStr(1, Cells(n, 2).Value, motachercher, vbTextCompare) <> 0 And InStr(1, Cells(n, 2).Value, motachercher2, vbTextCompare) <> 0 Then


Sheets("feuil3").Range("A" & ligne) = Sheets("feuil2").Range("E" & n)
Sheets("feuil3").Range("B" & ligne) = Sheets("feuil2").Range("b" & n)
Sheets("feuil3").Range("c" & ligne) = Sheets("feuil2").Range("A" & n)
Sheets("feuil3").Range("d" & ligne) = Sheets("feuil2").Range("C" & n)
Sheets("feuil3").Range("e" & ligne) = Sheets("feuil2").Range("D" & n)
ligne = ligne + 1
End If

Next n

Unload recherche
Sheets("feuil3").Select
Cliquez pour agrandir...

Bonsoir Gysmo,

Essaies en modifiant ta ligne de recherche comme suit :

Code: 
If InStr(1, Cells(n, 2).Value, motachercher, vbTextCompare) * InStr(1, Cells(n, 2).Value, motachercher2, vbTextCompare) > 0 Then

Espérant avoir résolu.

Cordialement.
 
Vote positif 0 Vote négatif
S

Softmama

XLDnaute Accro
Re : Recherche mot exact

Bonsoir,

Ton code recherche si 2 mots (ou bouts de mots) se trouvent bien dans les cellules de la colonne A de la feuil2. Si oui, la macro affiche les résultats de la recherche en feuil3, les uns sous les autres... Je comprends pas ce que tu appelles 'recherche exacte' Est-ce que ce sont les mots choisis dans les textbox, par exemple Excel, et pas leurs dérivés, par exemple Excellentissime ? Si oui, tu dois t'en sortir avec cette ligne à la place de ta ligne de recherche :

VB: 
If InStr(Cells(n, 2).Text, motachercher & " ") * InStr(Cells(n, 2).Text, motachercher2 & " ") > 0 Then

Mais, faut quand même avouer, que tes explications, elles sont méga floues !
 
Dernière édition:
Vote positif 0 Vote négatif
JNP

JNP

XLDnaute Barbatruc
Re : Recherche mot exact

Bonjour le fil :),

J'espère que tu ne m'en voudras pas, Softmama, si je trouve que ton code est du "bricolage" pas très performant :eek:...

En effet, il ne trouvera pas les mots en fin de phrase, avec une virgule ou un point derrière, trouvera les fins de mots (bel sortira avec label par exemple), il ne tient pas compte des majuscules (ça c'est ratrapable avec UCase :rolleyes:), etc. :p...

Sans vouloir mettre du RegExp partout, je pense que l'on est dans un cas de figure où il sera difficile de s'en passer :rolleyes:...

D'où, une petite fonction RegExp
Code: 
Function DeuxMots(Atester As String, Mot1 As String, Mot2 As String) As Boolean
Dim Flag1 As Boolean, Flag2 As Boolean
Application.Volatile
With CreateObject("vbscript.regexp")
    .Global = True
    .Pattern = "\b" & UCase(Mot1) & "\b"
    Flag1 = .Test(UCase(Atester))
    .Pattern = "\b" & UCase(Mot2) & "\b"
    Flag2 = .Test(UCase(Atester))
End With
DeuxMots = Flag1 * Flag2
End Function
avec un petit fichier exemple en PJ :p.

Pour mieux comprendre, je ne peux que vous encourager à consulter ce fil (ok, c'est un peu de l'autopromo :eek:).

Bonne journée :cool:
 

Pièces jointes

  • Deux mots.xlsm
    16.9 KB · Affichages: 88
Dernière édition:
Vote positif 0 Vote négatif
D

david84

XLDnaute Barbatruc
Re : Recherche mot exact

Bonjour,
En collaboration avec JNP:), ci-joint une possibilité en utilisant Evaluate (prise en compte des éléments de ponctuation tels que le point, la virgule et les parenthèses, à faire évoluer si besoin). Elle est plus rapide que RegExp sur des plages importantes mais présente la nécessité de devoir être complétée si d'autres éléments de ponctuation doivent être pris en compte.
Ceci-dit, dans ce cas de figure, l'utilisation de RegExp me semble la réponse la plus adaptée.
A+
 

Pièces jointes

  • DeuxMots_Evaluate.xls
    33 KB · Affichages: 65
Dernière édition:
Vote positif 0 Vote négatif
tototiti2008

tototiti2008

XLDnaute Barbatruc
Re : Recherche mot exact

Bonjour à tous,

Bon, je joue avec alors ;)

Sans RegExp :)p) et sans Evaluate, mais ne fonctionne pas avec les points, parenthèses, etc....

Code: 
Function DeuxMots2(Atester As String, Mot1 As String, Mot2 As String) As Boolean
Dim Flag1 As Boolean, Flag2 As Boolean, Tablo
    Tablo = Split(UCase(Atester))
    Flag1 = False
    Flag2 = False
    On Error Resume Next
    Flag1 = Application.Match(UCase(Mot1), Tablo, 0)
    Flag2 = Application.Match(UCase(Mot2), Tablo, 0)
    On Error GoTo 0
    DeuxMots2 = Flag1 * Flag2
End Function

Une question, pourquoi vous mettez tous Application.Volatile ?
Une fonction se recalcule de toutes façons si un de ses argument change, si vous voulez un recalcul lors du changement de n'importe quelle cellule, là OK, mais je ne crois pas que ce soit utile ici...
 
Vote positif 0 Vote négatif
G

Gysmo

XLDnaute Junior
Re : Recherche mot exact

Effectivement, après quelques test...le code de Sofmana a des petits ratés...j'aimerais savoir si le tiens peu être insérer dans mon code de recherche que j'ai mis en début de discussion....merci de prendre votre temps pour moi !
 
Vote positif 0 Vote négatif
JNP

JNP

XLDnaute Barbatruc
Re : Recherche mot exact

Re :),
Gysmo à dit:
j'aimerais savoir si le tiens peu être insérer dans mon code de recherche que j'ai mis en début de discussion....
Cliquez pour agrandir...
Après avoir copié ma fonction et/ou celle de David dans un module
Code: 
If DeuxMots(Cells(n, 2).Value, TextBox1.Value, TextBox3.Value) Then
tototiti2008 à dit:
Une question, pourquoi vous mettez tous Application.Volatile ?
Une fonction se recalcule de toutes façons si un de ses argument change, si vous voulez un recalcul lors du changement de n'importe quelle cellule, là OK, mais je ne crois pas que ce soit utile ici...
Cliquez pour agrandir...
C'est un habitude prise après s'être fait avoir plusieurs fois en formules de feuille :eek:... Et comme ça ne mange pas de pain :p...
Par contre, ne manquerait-il pas un séparateur " " dans ton Split :rolleyes: ?
Bonne fin de journée :cool:
 
Vote positif 0 Vote négatif
tototiti2008

tototiti2008

XLDnaute Barbatruc
Re : Recherche mot exact

Re,

Par contre, ne manquerait-il pas un séparateur " " dans ton Split
Cliquez pour agrandir...
Sans précision, Split sépare sur les espaces

Edit : Pierrot ;), Pas de soucis, moi je ne regarde même pas si les gens sont connectés ou pas avant de répondre à leur place :D, après tout il peut toujours avoir plus d'informations s'il y a plus de réponses
 
Dernière édition:
Vote positif 0 Vote négatif
JNP

JNP

XLDnaute Barbatruc
Re : Recherche mot exact

Re :),
Sinon, (en cherchant des améliorations avec David, ben j'ai fait des tests complémentaires) ma fonction RegExp semble avoir quelques soucis aussi avec les caractères accentués :eek:...
Le problème semble venir de \b qui signifie "Fin de mot" et que j'ai utilisé en "Début de mot", ce qui jusqu'à présent avait semblé fonctionner, mais là, des essais avec "âne" par exemple n'étaient pas reconnus :rolleyes:...
Je vous propose donc une seconde mouture
Code: 
Function DeuxMotsBis(Atester As String, Mot1 As String, Mot2 As String) As Boolean
Dim Flag1 As Boolean, Flag2 As Boolean
Application.Volatile
With CreateObject("vbscript.regexp")
    .Global = True
    .IgnoreCase = True
    .Pattern = "^" & Mot1 & "\b|[^a-zâàéèëêïîöôùû]" & Mot1 & "\b"
    Flag1 = .test(Atester)
    .Pattern = "^" & Mot2 & "\b|[^a-zâàéèëêïîöôùû]" & Mot2 & "\b"
    Flag2 = .test(Atester)
End With
DeuxMotsBis = Flag1 * Flag2
End Function
qui me parrait donner satisfaction. Merci de me dire si vous avez trouvé un exemple qui ne fonctionne pas ;)...
Bonne soirée :cool:
 
Vote positif 0 Vote négatif
S

Softmama

XLDnaute Accro
Re : Recherche mot exact

Bonjour,

Ok, j'avais en effet zappé certains aspects. J'espère avoir corrigé ici le pb (dsl pas trouvé plus simple^^):

VB: 
Function MotsOk(Mot As String, M1 As String, M2 As String) As Boolean
Dim Ponct1 As String, Ponct2 As String, A As String, B As String
Application.Volatile
'Signes à ignorer !!!!!!!
Ponct2 = "[ ,;.:()!?]"

Ponct1 = "*" & Ponct2
Ponct2 = Ponct2 & "*"
Mot = UCase(Mot): M1 = UCase(M1): M2 = UCase(M2)
A = InStr(Mot, M1)
B = InStr(Mot, M2)

If A * B > 0 Then 'Si y a les 2 mots
  If A > 1 Then
    If B > 1 Then
        If A < Len(Mot) - Len(M1) + 1 Then
            If B < Len(Mot) - Len(M2) + 1 Then
                If (Mot Like (Ponct1 & M1 & Ponct2)) And (Mot Like (Ponct1 & M2 & Ponct2)) Then MotsOk = True Else MotsOk = False
            Else
                If (Mot Like (Ponct1 & M1 & Ponct2)) And (Mot Like (Ponct1 & M2)) Then MotsOk = True Else MotsOk = False
            End If
        Else
            If B < Len(Mot) - Len(M2) + 1 Then
                If (Mot Like (Ponct1 & M1)) And (Mot Like (Ponct1 & M2 & Ponct2)) Then MotsOk = True Else MotsOk = False
            Else
                If (Mot Like (Ponct1 & M1)) And (Mot Like (Ponct1 & M2)) Then MotsOk = True Else MotsOk = False
            End If
        End If
    Else
        If A < Len(Mot) - Len(M1) + 1 Then
            If (Mot Like (Ponct1 & M1 & Ponct2)) And (Mot Like (M2 & Ponct2)) Then MotsOk = True Else MotsOk = False
        Else
            If (Mot Like (Ponct1 & M1)) And (Mot Like (M2 & Ponct2)) Then MotsOk = True Else MotsOk = False
        End If
    End If
  Else
    If B > 1 Then
        If B < Len(Mot) - Len(M2) + 1 Then
            If (Mot Like (M1 & Ponct2)) And (Mot Like (Ponct1 & M2 & Ponct2)) Then MotsOk = True Else MotsOk = False
        Else
            If (Mot Like (M1 & Ponct2)) And (Mot Like (Ponct1 & M2)) Then MotsOk = True Else MotsOk = False
        End If
    Else
        If (Mot Like (M1 & Ponct2)) And (Mot Like (M2 & Ponct2)) Then MotsOk = True Else MotsOk = False
    End If
  End If
End If
End Function

EDIT: Je viens de remarquer que ça ne fonctionne pas dans tous les cas de figure... grr
 

Pièces jointes

  • DeuxMots_LIKE.xls
    37.5 KB · Affichages: 88
  • DeuxMots_LIKE.xls
    37.5 KB · Affichages: 90
  • DeuxMots_LIKE.xls
    37.5 KB · Affichages: 90
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

S
  • Résolu(e)
Microsoft 365 Récupérer la date dans un calendrier
Réponses
2
Affichages
136
sebastien176
S
C
  • Résolu(e)
XL 2021 Remplir données devis en vba avec descriptions/quantités/PUs alignés
2
Réponses
18
Affichages
519
Phil69970
Phil69970
L
  • Question
Microsoft 365 Faire agir une macro en fonction de l'emplacement du bouton
Réponses
1
Affichages
72
AtTheOne
AtTheOne
P
  • Question
XL 2019 Copier des cellules d'une feuille sur une autre
Réponses
2
Affichages
259
phoceenjo
P
F
  • Question
Microsoft 365 Poursuivre ou pas la macro
Réponses
2
Affichages
214
Francky79
F
F
  • Résolu(e)
Microsoft 365 Recherche à partir d'une TextBox
Réponses
4
Affichages
190
Francky79
F
T
  • Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
1 K
thivame
T
F
  • Question
XL 2019 erreur 1004
Réponses
8
Affichages
258
florian50470
F
R
  • Question
XL 2021 Optimisation Code VBA
Réponses
10
Affichages
407
Dranreb
Dranreb
M
  • Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
128
marie3107
M

Membres actuellement en ligne

8 membres et 71 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 379
Messages
2 087 761
Membres
103 661
dernier inscrit
fcleves