Discussion :

[re]

Bonjour,
Je voudrai svp de l'aide sur une macro pour retrouver un mot qui est dans une cellule en comparaison d'une liste de mots qui sont dans une colonne
Exemple :
cellule A1 "Ceci est un test"
cellule A2 ''quel jour''
Etc...

Colonne C
jour
rien
un
Lorsque le scan de C trouve un mot qui est dans une cellule de la colonne A il devrait s'afficher en ligne B sur la même ligne que le mot contenu en A
Dans l'exemple B1 = ''un''
Que se passe t'il s'il y a 2 mots trouvé en A1 ?

Bien sur j'ai cherché sur le net mais pas réellement trouvé la bonne macro

Merci à vous

[Invité]

Bonjour,

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
35
36
37
38
39
40
41
42
43
44
45
 
Sub RechercherLesMots()
 
Dim AireDonnees As Range, AireListe As Range
Dim I As Long, J As Long, DerniereLigne As Long
Dim K As Integer
Dim TabMots As Variant
Dim MonDico As Scripting.Dictionary
 
    With Sheets("Feuil1")
 
         .Columns("B").ClearContents
 
         DerniereLigne = .Cells(.Rows.Count, "A").End(xlUp).Row
         Set AireDonnees = .Range(.Cells(1, "A"), .Cells(DerniereLigne, "A"))
 
         DerniereLigne = .Cells(.Rows.Count, "C").End(xlUp).Row
         Set AireListe = .Range(.Cells(1, "C"), .Cells(DerniereLigne, "C"))
 
         For I = 1 To AireDonnees.Count
             TabMots = Split(AireDonnees(I), " ")
             Set MonDico = CreateObject("Scripting.Dictionary")
 
             For K = LBound(TabMots) To UBound(TabMots)
                 For J = 1 To AireListe.Count
                   If AireListe(J) = TabMots(K) Then
                       If Not MonDico.Exists(TabMots(K)) Then
                           MonDico.Add (TabMots(K)), TabMots(K)
                           AireDonnees(I).Offset(0, 1) = AireDonnees(I).Offset(0, 1) & TabMots(K) & " "
                        End If
 
                   End If
 
                 Next J
             Next K
             Set MonDico = Nothing
         Next I
 
 
 
  End With
 
  Set AireDonnees = Nothing: Set AireListe = Nothing
 
End Sub

[re]

Bonjour Eric,
Merci beaucoup ça marche parfaitement, je l'ai modestement adaptée pour aller chercher les feuilles.
Petite précision il faut activer ''Microsoft Scripting Runtime''

Comment afficher un deuxième mot qui serait dans la BDD dans la même cellule, (colonne C dans l'exemple : Quel jour), ce mot ''Quel jour'' fait parti d'un ensemble de mot de la cellule de la colonne A

Bonne journée

[re]

Bonjour,
Le code me convient parfaitement
Mais comment supprimer l'espace à la fin du mot ?

Code :

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

AireDonnees(I).Offset(0, 1) = AireDonnees(I).Offset(0, 1) & TabMots(K) & " "

S'il y a deux mots en supprimant l'espace entre " " aura pour effet de coller les 2 mots (DeuxMots) au lieu de Deux Mots
je n'ai pas su intégrer =supprespace(A1) par exemple (pas sur que ce soit la bonne méthode)

Merci

[Invité]

A tester, voir en ligne 36.

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
35
36
37
38
39
40
41
42
43
44
45
46
 
Sub RechercherLesMots()
 
Dim AireDonnees As Range, AireListe As Range
Dim I As Long, J As Long, DerniereLigne As Long
Dim K As Integer
Dim TabMots As Variant
Dim MonDico As Scripting.Dictionary
 
    With Sheets("Feuil1")
 
         .Columns("B").ClearContents
 
         DerniereLigne = .Cells(.Rows.Count, "A").End(xlUp).Row
         Set AireDonnees = .Range(.Cells(1, "A"), .Cells(DerniereLigne, "A"))
 
         DerniereLigne = .Cells(.Rows.Count, "C").End(xlUp).Row
         Set AireListe = .Range(.Cells(1, "C"), .Cells(DerniereLigne, "C"))
 
         For I = 1 To AireDonnees.Count
             TabMots = Split(AireDonnees(I), " ")
             Set MonDico = CreateObject("Scripting.Dictionary")
 
             For K = LBound(TabMots) To UBound(TabMots)
                 For J = 1 To AireListe.Count
                   If AireListe(J) = TabMots(K) Then
                       If Not MonDico.Exists(TabMots(K)) Then
                           MonDico.Add (TabMots(K)), TabMots(K)
                           AireDonnees(I).Offset(0, 1) = AireDonnees(I).Offset(0, 1) & TabMots(K) & " "
                        End If
 
                   End If
 
                 Next J
             Next K
             AireDonnees(I).Offset(0, 1) = Trim(AireDonnees(I).Offset(0, 1))
             Set MonDico = Nothing
         Next I
 
 
 
  End With
 
  Set AireDonnees = Nothing: Set AireListe = Nothing
 
End Sub

[re]

Bonjour
pardon pour ma réponse tardive.
Merci, ça fonctionne

[re]

Bonjour,
Votre code fonctionne parfaitement pour un mot mais s'il y a une occurrence ça me pose un petit souci pour identifier qui est qui ,-)
Exemple sur 2 cellules

A1 = Commission cotisation à une offre => extraire ''Commission offre'' => l’identification serait ''Multimédia"
A2 = Commission virement SEPA => extraire ''Commission SEPA'' => l’identification serait ''Banque"

L'identification est rentrée manuellement dans une autre colonne pour chaque nouveau mot, elle est copiée dans une BDD et récupérée automatiquement si besoin lors d'un nouvel import

Est-il possible dans ce même code d'imposer certains mots qui sont dans la même cellule ?
Le résultat devrait être Commission offre et Commission SEPA et pas seulement la même réponse ''Commission'' pour les deux cas, l'ordre des mots est bien souvent 'aléatoire''

les données du fichier CSV que je dois extraite sont parfois incompréhensibles un court exemple : REF/9982851745 Motif AZBT / AAA Commission cotisation LIB//161718881/I offre xxxx333 (et encore j'ai filtré)

J'espère que mes explications sont claires...

Merci

[Invité]

Il faudrait spliter la liste des mots clés dans la liste (liste des mots clés sur une même ligne) et ajouter une boucle à l'intérieur de la boucle J pour identifier les différents mots.

[Pierre Fauconnier]

Salut.

Je ne suis pas certain d'avoir tout compris, mais si tu veux extraire des mots-clés présents dans une liste, tu pourrais peut-être te tourner vers les expressions rationnelles. Ici, pour simplifier le motif, la chaine et les mots-clé sont repris en minuscules

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
Function MotsTrouves(Phrase As String, Motscles As Range) As String
  Dim RegExp As Object
  Dim Matches As Object
  Dim SubMatch As Object
  Dim r As Range
  Dim Pattern As String
 
  ' Création du motif
  Set RegExp = CreateObject("VBScript.RegExp")
  For Each r In Motscles
    Pattern = Pattern & "\b" & r.Value & "\b|"
  Next
  Pattern = LCase(Left(Pattern, Len(Pattern) - 1))
  RegExp.Pattern = Pattern
 
  ' Création du tableau de résultat
  RegExp.Global = True
  Set Matches = RegExp.Execute(LCase(Phrase))
  For Each SubMatch In Matches
    RegExp.Pattern = "\b" & SubMatch & "\b" ' On teste si le mot-clé a déjà été poussé
    If Not RegExp.test(MotsTrouves) Then MotsTrouves = MotsTrouves & SubMatch.Value & ";"
  Next SubMatch
  If MotsTrouves <> "" Then MotsTrouves = Left(MotsTrouves, Len(MotsTrouves) - 1)
 
  Set RegExp = Nothing
  Set Matches = Nothing
  Set SubMatch = Nothing
End Function

[re]

Bonjour Pierre et merci pour ton retour,

Tu as parfaitement compris la demande mais bien sûr je n'arrive pas écrire la syntaxe ;-)

Dans la fonction en B2: =MotsTrouves([@Phrase];t_MotsCherchés[Mot]), t_MotsCherchés c'est quoi ?

Si j'ai bien compris en colonne E ça serait les mots qu'il y aurait dans la BDD ?
Si c'est le cas le résultat de B est bien le résultat attendu et c'est ce que je recherche (peut être sans les ; mais c'est gérable )

Bonne journée

[Pierre Fauconnier]

Le tableau des mots à trouver s'appelle t_MotsCherchés. C'est un tableau structuré (voir mon tuto sur les tableaux structurés si tu ne connais pas trop). Tu pourrais avoir une plage classique, mais je trouve plus intéressant de travailler avec des tableaux structurés.




Pour le séparateur, ça se passe dans la fonction perso à placer dans un module standard du classeur. Ici, je l'ai adaptée pour que tu puisses choisir le séparateur qui te convient, qui peut tenir sur un seul caractère comme sur plusieurs. sur l'illustration qui suit, j'ai mis " | " comme séparateur à 3 caractères. Comme "mots à rechercher", tu pourrais aussi choisir une locution de plusieurs mots si tu le souhaites.

Code :

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

<a href="https://fauconnier.developpez.com/tutoriels/tableaux-structures/" target="_blank">mon tuto sur les tableaux structurés</a>

[re]

Bonjour Pierre
Merci beaucoup, tes explications sont claires, effectivement j'avais nommé le tableau ''Mot'' au lieux de de ''t_Motscherchés''

Pour le séparateur, je n'ai pas trop compris, si rentre ta formule =MotsTrouves([@Phrase];t_MotsCherchés[Mot];" |"), ça met #Valeur! .
Pour modifier le séparateur il faut que je modifie cette ligne

Code :

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

If Not RegExp.test(MotsTrouves) Then MotsTrouves = MotsTrouves & SubMatch.Value & " |"

avec cette formule =MotsTrouves([@Phrase];t_MotsCherchés[Mot]).
Je n'ai donc pas le choix pour choisir le séparateur dans la formule, ce n'est pas important mais c'est pour comprendre

Autre phénomène dans l'exemple ci-dessous, ça créé un espace en début avec le séparateur

Si j'utilise un espace en lieu et place d'un séparateur, ça fonctionne avec cette formule =SUPPRESPACE(MotsTrouves([@Phrase];t_MotsCherchés[Mot])).
Encore une fois je peux me contenter d'un espace pour les séparateurs

Bonne journée

[re]

Bonjour
Comment modifier ce dernier programme pour que s'il y a un mot répété dans une cellule de la colonne A un seul est affiché dans une cellule en colonne B ?
Merci beaucoup

[Pierre Fauconnier]

La solution que j'ai donnée le 15/05 ne répète pas le mot s'il se trouve plusieurs fois comme illustré dans la copie d'écran, sauf erreur de ma part

[re]

Bonjour,
Effectivement sans modification ça marche
Plus sérieusement j'ai cru bon pour afficher en majuscule d'ajouter UCase :

Code :

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

If Not RegExp.Test(MotsTrouves) Then MotsTrouves = UCase(MotsTrouves & SubMatch.Value & " ")

Ca affiche bien en majuscule mais il y a répétition du mots si ce mot est plusieurs fois dans la cellule.
Peux-tu me donner la bonne syntaxe ?

Merci

[Pierre Fauconnier]

C'est normal car à la ligne qui teste si le mot est déjà repris, on le passe en minuscule alors qu'on l'a poussé en majuscule.
Voici une solution au problème. Les modifs sont au niveau des <===

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
Function MotsTrouves(Phrase As String, Motscles As Range) As String
  Dim RegExp As Object
  Dim Matches As Object
  Dim SubMatch As Object
  Dim r As Range
  Dim Pattern As String
 
  Set RegExp = CreateObject("VBScript.RegExp")
  For Each r In Motscles
    Pattern = Pattern & "\b" & r.Value & "\b|"
  Next
  Pattern = LCase(Left(Pattern, Len(Pattern) - 1))
  RegExp.Pattern = Pattern
 
  RegExp.Global = True
  Set Matches = RegExp.Execute(Phrase)
  For Each SubMatch In Matches
    RegExp.Pattern = "\b" & UCase(SubMatch) & "\b" ' <=== On passe en majuscules
    If Not RegExp.test(MotsTrouves) Then MotsTrouves = MotsTrouves & UCase(SubMatch.Value) & ";" ' <=== On passe en majuscules
  Next SubMatch
  If MotsTrouves <> "" Then MotsTrouves = Left(MotsTrouves, Len(MotsTrouves) - 1)
 
  Set RegExp = Nothing
  Set Matches = Nothing
  Set SubMatch = Nothing
End Function

[re]

Bonjour,
C'est réactif,
C'est top
Ca fonctionne parfaitement

Merci
Bonne journée