Recherche mot exact

[Gysmo]

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

 

[Softmama]

Re : Recherche mot exact

Donc,
la version qui évite un max de pièges (dites-moi si y a encore des soucis) :

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, Ok1 As Boolean, Ok2 As Boolean
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)

1 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 GoTo 2
            Else
                If (Mot Like (Ponct1 & M1 & Ponct2)) And (Mot Like (Ponct1 & M2)) Then MotsOk = True Else GoTo 2
            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 GoTo 2
            Else
                If (Mot Like (Ponct1 & M1)) And (Mot Like (Ponct1 & M2)) Then MotsOk = True Else GoTo 2
            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 GoTo 2
        Else
            If (Mot Like (Ponct1 & M1)) And (Mot Like (M2 & Ponct2)) Then MotsOk = True Else GoTo 2
        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 GoTo 2
        Else
            If (Mot Like (M1 & Ponct2)) And (Mot Like (Ponct1 & M2)) Then MotsOk = True Else GoTo 2
        End If
    Else
        If (Mot Like (M1 & Ponct2)) And (Mot Like (M2 & Ponct2)) Then MotsOk = True Else GoTo 2
    End If
  End If
End If
Exit Function
2
If InStr(A + 1, Mot, M1) > 0 Then A = InStr(A + 1, Mot, M1): GoTo 1
If InStr(B + 1, Mot, M2) > 0 Then B = InStr(B + 1, Mot, M2): GoTo 1

End Function

 

[JNP]

Re : Recherche mot exact

Re ,

Donc,
la version qui évite un max de pièges (dites-moi si y a encore des soucis) :

Désolé de t'avoir titillé, je n'ai pas trouvé de défaut (enfin, sur les tests que j'ai fait), mais ce code est "plus pro" (enfin, plus proche de ceux auquels tu m'avais habitué) !
Ça reste un peu lourd, mais seul le résultat compte !
Bonne soirée

 

[Softmama]

Re : Recherche mot exact

Re,

Aucun souci JNP, bien au contraire. Ta remarque était entièrement fondée et ma réponse initiale occultait des aspects importants du problème. Je te remercie de l'avoir signalé... sauf que je n'aime pas rester sur un truc mal fichu, alors j'ai pondu une solution de mon côté ^^
++

 

[JNP]

Re : Recherche mot exact

Re ,

sauf que je n'aime pas rester sur un truc mal fichu, alors j'ai pondu une solution de mon côté ^^

Ok. Alors, 2 cas de figure qui ne passent pas avec ton code ...
Recherche "âne" et phrase "Saucisson d'âne"
"-Bel exemple" pour "bel"
Complexe, mais interressant, non ...
Bonne soirée

 

[Softmama]

Re : Recherche mot exact

Re,

Je me suis dit aussi JNP, qu'il existait sûrement plus simple avec la même méthode et pour le même résultat que mon usine à gaz précédente... :

Function MotsOk2(Mot As String, M1 As String, M2 As String) As Boolean
Application.Volatile
  Dim Ponct As String, A As String, B As String

  'Signes à ignorer !!!!!!!
  Ponct = "[ ;:.,)!?(-]"
  Mot = UCase(Mot): M1 = UCase(M1): M2 = UCase(M2)
  A = InStr(Mot, M1): B = InStr(Mot, M2)

1 If A * B > 0 Then 'Si y a les 2 mots
    If (Mot Like (IIf(A = 1, "", "*" & Ponct) & M1 & IIf(A < Len(Mot) - Len(M1) + 1, Ponct & "*", ""))) And (Mot Like (IIf(B = 1, "", "*" & Ponct) & M2 & IIf(B < Len(Mot) - Len(M2) + 1, Ponct & "*", ""))) Then MotsOk2 = True: Exit Function
  End If
  If InStr(A + 1, Mot, M1) > 0 Then A = InStr(A + 1, Mot, M1): GoTo 1
  If InStr(B + 1, Mot, M2) > 0 Then B = InStr(B + 1, Mot, M2): GoTo 1

End Function

Edit: JNP, si, ça fonctionne avec Saucisson d'âne et -âne si tu rajoutes le symbole - et ' à la liste qui se situe à cette ligne ainsi, tu peux aussi ajouter & # + =... à toi de voir :
Ponct = "[ ;:.,)!?('&#+=-]"

 

[JNP]

Re : Recherche mot exact

Re ,

Edit: JNP, si, ça fonctionne avec Saucisson d'âne et -âne si tu rajoutes le symbole - et ' à la liste qui se situe à cette ligne ainsi, tu peux aussi ajouter & # + =... à toi de voir :
Ponct = "[ ;:.,)!?('&#+=-]"

Effectivement, ce que je voulais dire par là, c'est que la liste risquait de s'allonger démesurement ... Il pourrait y avoir aussi un Chr(10), /, \, etc. ...
C'est pourquoi je suis parti d'un patern inversé en disant "tout sauf" codifié par "^" dans le Pattern (j'avais d'ailleur oublié 2 caractères )

"\b|[^a-zâàéèëêïîöôùûæœ]" & Mot1 & "\b"

mais en retournant sur l'aide de Like (qui accepte des classes, mais est malheureusement moins flexible que RegExp), j'ai vu qu'il y avait aussi un caractère "tout sauf" pour les classes avec le "!", donc je proposerais plutôt pour ton code

Ponct = "[!A-ZÂÀÉÈËÊÏÎÖÔÙÜÛÆŒ]"

qui devrait fonctionner dans tous les cas de figure .
Je préfère largement ton nouveau code plus compact que le premier fourni !
Gysmo possède donc maintenant au moins 2 fonctions quasiment infaillibles !
Un dernier conseil à Gysmo : S'il y a beaucoup de lignes de recherche, le plus rapide serait de passer par Find et FindNext en recherche d'un des 2 mots, puis d'appliquer une de nos fonctions pour valider si la cellule renvoyée est OK .
Bonne journée