Recherche d'un mot ENTIER dans une autre chaîne, sans respecter la casse (+ ponctuation)

**IaMTouF** · 05/09/2012, 14h44

Bonjour à tous !!!!!!

Voilà mon soucis :

Je voudrais pouvoir vérifier la présence d'un mot dans une autre chaîne. Je connais la fonction InStr mais ça ne me convient pas pour la raison suivante : je veux savoir si le mot entier uniquement est présent.

Exemple :

Je recherche le mot

lan

dans le texte suivant :

L'athlète lance le javelot à une distance phénoménale !!!

(désolé j'ai mangé trops de J.O. cet été ^^")

La fonction InStr va donc me renvoyer "11" ici puisqu'on trouve bien la chaîne "lan" à partir de la position 11.

Or, dans mon cas, je veux uniquement trouver le mot "lan". Je ne veux pas qu'il fasse partis d'une autre mot.

De plus, il faut prévoir les points, points d'exclamation, points d'interrogation, etc...

Par exemple, dans la phrase suivante, la recherche devra me renvoyer VRAI :

J'ai fait bon nombre de lan. Notamment sur Counter Strike Source.

Quelqu'un aurait-il une idée ?

Merci d'avance.
Cordialement.

PS : j'ai pensé aux expressions régulières, mais je ne maitrise pas ça du tout, et je ne suis même pas certain qu'elles permettent de faire ça. De plus leur utilisation sous Excel en VBA m'est inconnue...

**QuestVba** · 05/09/2012, 16h04

Bonjour,

Voici un début.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Chercher()
 
For j = 1 To ActiveWindow.RangeSelection.Count
 
  nomachercher = "lan"
 
  Sheets(1).Select
  Range("a1").Select
  tailledemot = Len(nomachercher)
  Do While ActiveCell.Value <> ""
    For x = 1 To Len(ActiveCell)
        Car = Mid(ActiveCell, x, tailledemot)
        apr = Mid(ActiveCell, x + 3, 1)
            If Car = nomachercher And Mid(ActiveCell, x + 3, 1) = " " Or Mid(ActiveCell, x + 3, 1) = "." Then
                    MsgBox nomachercher & " trouvé"
              End If
    Next x
    ActiveCell.Offset(1, 0).Select
  Loop
 
Next j
 
End Sub

rdp937 · 05/09/2012, 16h23

Bonjour,

Un truc comme ça..

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
Sub test()
    testChaine ("lan") 'Chaine à rechercher'
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
 
Function testChaine(chaineRecherchee)
 
Dim signePonctuation As String, chaineParcourue As String
 
signePonctuation = "[.!#$%&'*/=?^_`{|}~+-]"
 
 
For n = 1 To Range("A65536").End(xlUp).Row 'Parcours de toutes les chaines dans la colonne A
 
    chaineParcourue = Cells(n, 1).Value 'Chaine de recherche'
 
    nbreCaractereChaineRecherche = Len(chaineRecherchee) 'nombre de caractere de la chaine recherchée
    nbreCaractereChaine = Len(chaineParcourue) 'nombre de caractere de la chaine de recherche
 
 
    StrValue = InStr(1, chaineParcourue, chaineRecherchee, 1) '
 
    chaineDroite = Right(Left(chaineParcourue, StrValue - 1), 1)
    chaineGauche = Right(Left(chaineParcourue, StrValue + nbreCaractereChaineRecherche), 1)
 
    If chaineDroite = " " Then 'Si la chaine avant est vide
        If Mid(chaineGauche, 1, 1) Like signePonctuation Then 'Si c'est un signe de ponctuation
            Cells(n, 2).Value = "VRAI"
        Else
            Cells(n, 2).Value = "FAUX"
        End If
    Else
        Cells(n, 2).Value = "FAUX"
    End If
 
Next n
 
End Function

**issoram** · 05/09/2012, 16h45

Bonjour,

Les expressions régulières sont très pratiques pour ce genre de problème. Mais si tu veux t'en passer il te faudra faire une "fonction maison"

Un pseudo-algo à implémenter (dans la même idée que les 2 réponses précédentes).

On cherche la chaine1 dans la chaine2 (avec instr)
Si on la trouve: on regarde les caractères qui l'entourent dans la chaine2
Si ces caractères sont dans les listes des caractères de début et fin de mot (libres à toi de mettre ce que tu veux en fonction de ton problème) alors renvoi vrai
sinon renvoie faux

Bon courage

**Patrice740** · 05/09/2012, 22h07

Bonjour,

Essaies ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub Test()
Dim texte As String
Dim chaine As String
 
  chaine = "language"
  texte = "Les languages et les abus de language."
  If testChaine(texte, chaine) Then MsgBox "Trouvé" Else MsgBox "Pas trouvé"
 
End Sub
 
Function testChaine(texte As String, chaine As String) As Boolean
Dim ptr As Long
 
  ptr = 0
  Do
    ptr = InStr(ptr + 1, " " & texte, chaine, 1)
    If ptr = 0 Then Exit Do
    testChaine = Mid(" " & texte & " ", ptr - 1, Len(chaine) + 2) _
                 Like "[ (""']" & chaine & "[ ,.!?'""]"
  Loop While Not testChaine
 
End Function

Invité · 06/09/2012, 07h52

Bonjour

Si j'ai bien compris.

En utilisant un tableau et en mettant chaque mot dans ce tableau à l'aide de la fonction split.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Public Function RechercheDansChaine(strChaine As String, strMot As String) As Long
    ' déclaration
    Dim tabString() As String 'on déclare un tableau
    Dim i As Integer          ' pour parcourir le tableau
    Dim cpt As Long        ' pour compter les occurences
 
    ' on remplit le tableau un mot par ligne
    tabString = Split(strChaine, " ")
 
    ' on liste les mots
    For i = 0 To UBound(tabString())
        If tabString(i) = strMot Then
            cpt = cpt + 1
        End If
    Next i
 
    RechercheDansChaine = cpt
End Function

exemple :

recherchedanschaine("qsdsd lan sqdfs qsdfsdf lan lan qsdfs","lan")

retourne 3, car le mot lan apparait 3 fois dans la chaine.

Il te suffit donc de tester la valeur de retour.

Philippe

**gFZT82** · 06/09/2012, 09h34

Bonjour,

J’ai repris l’idée de issoram pour vérifier la présence du mot.
La difficulté est de définir quels sont les caractères admis avant et après le mot recherché.
Dans le code que je te propose, cette liste est pré renseignée dans un tableau, le problème étant que le résultat sera erroné si cette liste n’est pas exhaustive.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Tablo
Dim Pos As Integer, i As Integer, j As Integer
Dim Chaine As String, Mot As String, Resultat As String
    Chaine = Target.Value
    Mot = InputBox("Mot à rechercher ?")
    If Mot = "" Then Exit Sub
    Resultat = "Absent"
    'On liste les caractères acceptés pour préceder ou suivre le mot recherché.
    Tablo = Array(".", ",", ";", "-", "!", "?", ":", "'", "(", ")", " ", "{", "}", "[", "]")
    ' on recherche le mot dans la ligne
    Pos = InStr(1, Chaine, Mot, 1)
    'Si le mot a été trouvé
    If Pos > 0 Then
        'On vérifie que le caractère précédant et le caractère suivant appartiennent à la liste.
        'Nota : le mot ayant été trouvé, si les caractères précédant et suivant le mot font partie de la liste
        'des caractères acceptés, on considère que le mot est présent.
        For i = 0 To UBound(Tablo)
            If Mid(Chaine, Pos - 1, 1) = Tablo(i) Then
                For j = 0 To UBound(Tablo)
                    If Mid(Chaine, Pos + Len(Mot), 1) = Tablo(j) Then Resultat = "Présent"
                Next j
            End If
        Next i
    End If
    MsgBox "Le mot " & Mot & " est " & Resultat
End Sub

Cordialement.

**IaMTouF** · 06/09/2012, 09h59

Je tiens tout d'abord à remercier tout le monde d'avoir pris du temps pour tenter de résoudre mon problème !!!

J'ai essayé la plupart des propositions faites. Certaines se repprochent de mon problème, d'autres un peu moins. Il y en a certaines que j'ai eu un peu plus de mal à comprendre, mais en définitif j'ai retenu la suivante :

Envoyé par Patrice740

Bonjour,

Essaies ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub Test()
Dim texte As String
Dim chaine As String
 
  chaine = "language"
  texte = "Les languages et les abus de language."
  If testChaine(texte, chaine) Then MsgBox "Trouvé" Else MsgBox "Pas trouvé"
 
End Sub
 
Function testChaine(texte As String, chaine As String) As Boolean
Dim ptr As Long
 
  ptr = 0
  Do
    ptr = InStr(ptr + 1, " " & texte, chaine, 1)
    If ptr = 0 Then Exit Do
    testChaine = Mid(" " & texte & " ", ptr - 1, Len(chaine) + 2) _
                 Like "[ (""']" & chaine & "[ ,.!?'""]"
  Loop While Not testChaine
 
End Function

Bonjour Patrice,

Ta solution est celle qui se rapproche le plus de mon problème. Elle convient parfaitement à un détail près : la fonction respecte la casse.

En reprenant ton exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
chaine = "language"
  texte = "Les languages et les abus de language."
  If testChaine(texte, chaine) Then MsgBox "Trouvé" Else MsgBox "Pas trouvé"

Si on remplace "language" par "Language", j'aimerais qu'on obtienne quand même un résultat positif ("Trouvé" dans ton exemple). En effet, le mot peut très bien être en début de phrase (donc majuscule oblige), les personnes tapant les mots peuvent se tromper et mettre une majuscule dans le mot, etc...

Sinon pour le reste, la fonction tourne à merveille et correspond parfaitement à ce que je cherche. J'essaies de trouver comment contourner le problème de la casse de mon côté.

Si vous avez des pistes n'hésitez pas.

Cordialement

**IaMTouF** · 06/09/2012, 10h07

Bon et bien ce n'était pas sorcier finalement j'ai trouvé pour la casse :
j'ai simplement utilisé la fonction LCase qui permet de convertir tous les caractères des deux chaines en minuscule.

Une des solutions finales possibles à mon problème est donc :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Function testChaine(texte As String, chaine As String) As Boolean
 
    Dim ptr As Long
 
    texte = LCase(texte)
    chaine = LCase(chaine)
    ptr = 0
 
    Do
        ptr = InStr(ptr + 1, " " & texte, chaine, 0)
        If ptr = 0 Then Exit Do
        testChaine = Mid(" " & texte & " ", ptr - 1, Len(chaine) + 2) _
                     Like "[ (""']" & chaine & "[ ,.!?'""]"
    Loop While Not testChaine
 
End Function