Microsoft 365 Code VBA Recherche par mots clés

[looky62]

Hello la communauté,

Je suis bloqué sur mon codage, qui peut m'éclairer

En feuil2 colonne A, ligne avec du texte, je souhaite insérer en colonne B les mots recherchés qui se trouve dans la feuil1 a partir de A2, si les mots recherches à partir de la colonne B à partir de B2, alors mettre le mot qui correspond a la colonne A, exemple , si en feuil1 se trouve un mot en B4 dans la feuil2 alors mettre le mot correspondant à la ligne en A4 et ainsi de suite, de base ma macro ne trouve pas les mots, pourtant je respecte bien l'orthographe d'où vient le pb?

Serait il possible d'ajouter plusieurs mots clés a chercher par exemple, si différente orthographe, entre: résiliation, resiliation, résil, à résilier, ce qui ramenerai en colonne B de la feuil2 le mot Résiliation à faire!

Sub RechercherMots()

' Déclaration des variables
Dim Feuil1 As Worksheet
Dim Feuil2 As Worksheet
Dim DernLigne1 As Long
Dim DernLigne2 As Long
Dim i As Long
Dim j As Long
Dim MotRecherche As String

' Récupération des références aux feuilles de calcul
Set Feuil1 = ThisWorkbook.Worksheets("Feuil1")
Set Feuil2 = ThisWorkbook.Worksheets("Feuil2")

' Trouver la dernière ligne contenant des données dans chaque feuille
DernLigne1 = Feuil1.Cells(Rows.Count, "A").End(xlUp).Row
DernLigne2 = Feuil2.Cells(Rows.Count, "A").End(xlUp).Row

' Parcourir chaque ligne de la colonne B de la feuille 2
For i = 2 To DernLigne2
' Récupérer le mot à rechercher dans la colonne B de la feuille 2
MotRecherche = Feuil2.Cells(i, "B").Value
' Parcourir chaque ligne de la colonne A de la feuille 1
For j = 2 To DernLigne1
' Vérifier si le mot à rechercher se trouve dans la colonne B de la feuille 1
If Feuil1.Cells(j, "B").Value = MotRecherche Then
' Insérer le mot correspondant dans la colonne B de la feuille 2
Feuil2.Cells(i, "A").Value = Feuil1.Cells(j, "A").Value
' Sortir de la boucle de recherche dans la feuille 1 pour passer au mot suivant
Exit For
End If
Next j
Next i

End Sub

 

[fanch55]

Bonjour,
SI vous voulez partager du code, utilisez le bouton approprié sur la conversation,
c'est plus agréable et clair à lire ...

 

[looky62]

Sub RechercherMots()

' Déclaration des variables
Dim Feuil1 As Worksheet
Dim Feuil2 As Worksheet
Dim DernLigne1 As Long
Dim DernLigne2 As Long
Dim i As Long
Dim j As Long
Dim MotRecherche As String

' Récupération des références aux feuilles de calcul
Set Feuil1 = ThisWorkbook.Worksheets("Feuil1")
Set Feuil2 = ThisWorkbook.Worksheets("Feuil2")

' Trouver la dernière ligne contenant des données dans chaque feuille
DernLigne1 = Feuil1.Cells(Rows.Count, "A").End(xlUp).Row
DernLigne2 = Feuil2.Cells(Rows.Count, "A").End(xlUp).Row

' Parcourir chaque ligne de la colonne B de la feuille 2
For i = 2 To DernLigne2
' Récupérer le mot à rechercher dans la colonne B de la feuille 2
MotRecherche = Feuil2.Cells(i, "B").Value
' Parcourir chaque ligne de la colonne A de la feuille 1
For j = 2 To DernLigne1
' Vérifier si le mot à rechercher se trouve dans la colonne B de la feuille 1
If Feuil1.Cells(j, "B").Value = MotRecherche Then
' Insérer le mot correspondant dans la colonne B de la feuille 2
Feuil2.Cells(i, "A").Value = Feuil1.Cells(j, "A").Value
' Sortir de la boucle de recherche dans la feuille 1 pour passer au mot suivant
Exit For
End If
Next j
Next i

End Sub

 

[xUpsilon]

Bonjour,

Une fois n'est pas coutume : où est le fichier ?

Bonne journée,

 

[looky62]

Bonjour,

Une fois n'est pas coutume : où est le fichier ?

Bonne journée,

 

[looky62]

Oui désolé, j'ai enlevé les information commercial sensible, ci joint l'exemple le but aussi et d'enrichir ma base de donnée en feuil 1

 

[job75]

Bonjour looky62, le fil,

La gymnastique que vous voulez faire est bien compliquée alors qu'il suffit de filtrer avec le filtre avancé :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim critere
critere = Split(Application.Trim([C1]), ", ") 'attention au séparateur
If UBound(critere) = -1 Then ShowAllData: Exit Sub
Application.EnableEvents = False 'désactive les évènements
ThisWorkbook.Names.Add "Crit", critere 'nom défini
[H2] = "=SUMPRODUCT(N(ISNUMBER(SEARCH(Crit,A2))))" 'critere de filtrage
[A1].CurrentRegion.AdvancedFilter xlFilterInPlace, [H1:H2] 'filtre avancé
[H2] = ""
Application.EnableEvents = True 'réactive les évènements
End Sub

A+

 

[looky62]

Bonjour looky62, le fil,

La gymnastique que vous voulez faire est bien compliquée alors qu'il suffit de filtrer avec le filtre avancé :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim critere
critere = Split(Application.Trim([C1]), ", ") 'attention au séparateur
If UBound(critere) = -1 Then ShowAllData: Exit Sub
Application.EnableEvents = False 'désactive les évènements
ThisWorkbook.Names.Add "Crit", critere 'nom défini
[H2] = "=SUMPRODUCT(N(ISNUMBER(SEARCH(Crit,A2))))" 'critere de filtrage
[A1].CurrentRegion.AdvancedFilter xlFilterInPlace, [H1:H2] 'filtre avancé
[H2] = ""
Application.EnableEvents = True 'réactive les évènements
End Sub

A+

Merci pour votre approche, toutefois l idée est de faire ensuite un TCD avec mon résultat, car là j'ai mis qq exemples, mais mon fichier fait 10000lignes, pas évitdent mais l'approche m a appris qq chose!

 

[job75]

J'ai donné une solution simple, vous en faites ce que vous voulez.

 

[job75]

Notez qu'en C1 on peut utiliser des caractères génériques * ou ?

Par exemple r?sil au lieu de résil, resil

 

[looky62]

Notez qu'en C1 on peut utiliser des caractères génériques * ou ?

Par exemple r?sil au lieu de résil, resil

Merci je vais l'utliser pr une autre fonctionnalité mais ce que je recherche c plus av mon tableau de mots clés que je peux enrichir en fonction des différents verbatims que j'ai

 

[fanch55]

Bonsoir,
Classeur à tester

 

[job75]

Bonjour looky62, le forum,

Bon puisque vous y tenez voyez le fichier joint et cette macro, toujours avec le filtre avancé :

Private Sub Worksheet_Activate()
Dim P As Range, titre$, i&, critere
Set P = [A1].CurrentRegion
titre = P(1, 2)
Application.ScreenUpdating = False
P.Columns(2).ClearContents 'RAZ
With Sheets("Feuil1").[A1].CurrentRegion 'feuille des critères
    For i = 2 To .Rows.Count
        critere = Split(Application.Trim(.Cells(i, 2)), ", ") 'attention au séparateur
        If UBound(critere) >= 0 Then
            ThisWorkbook.Names.Add "Crit", critere 'nom défini
            [H2] = "=SUMPRODUCT(N(ISNUMBER(SEARCH(Crit,A2))))" 'critere de filtrage
            P.AdvancedFilter xlFilterInPlace, [H1:H2] 'filtre avancé
            P.Columns(2).SpecialCells(xlCellTypeVisible) = .Cells(i, 1) 'remplissage
        End If
    Next
End With
If FilterMode Then ShowAllData 'RAZ
[H2] = ""
P(1, 2) = titre
End Sub

Elle se déclenche quand on active la 1ère feuille.

A+

 

[fanch55]

Salut @job75
Attention au

Set P = [A1].CurrentRegion

S'arrête à la première ligne vide trouvée

 

[job75]

S'arrête à la première ligne vide trouvée

Bien sûr, il faut éviter les lignes vides.