Sub RechercheMotCle()
Dim wsDonnees As Worksheet
Dim wsMotsCles As Worksheet
Dim rngDonnees As Range
Dim rngMotsCles As Range
Dim dict As Object
Dim data As Variant
Dim i As Long
Dim mot As Variant
Dim motTrouve As String
' Désactiver certaines fonctionnalités pour améliorer les performances
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
' Feuilles de travail
Set wsDonnees = ThisWorkbook.Sheets("données")
Set wsMotsCles = ThisWorkbook.Sheets("TABLE MOTS CLES")
' Plages de données
Set rngDonnees = wsDonnees.Range("E2:E" & wsDonnees.Cells(wsDonnees.Rows.Count, "E").End(xlUp).Row)
Set rngMotsCles = wsMotsCles.Range("B2:C" & wsMotsCles.Cells(wsMotsCles.Rows.Count, "B").End(xlUp).Row)
' Créer un dictionnaire pour stocker les mots clés et leurs valeurs associées
Set dict = CreateObject("Scripting.Dictionary")
For Each mot In rngMotsCles
dict(mot.Value) = mot.Offset(0, 1).Value
Next mot
' Stocker les données dans un tableau
data = rngDonnees.Value
' Parcourir chaque cellule dans le tableau
For i = 1 To UBound(data, 1)
motTrouve = ""
' Parcourir chaque mot clé dans le dictionnaire
For Each mot In dict.Keys
' Si le mot clé est trouvé dans la cellule
If InStr(1, data(i, 1), mot, vbTextCompare) > 0 Then
' Stocker la valeur associée
motTrouve = dict(mot)
Exit For
Else
motTrouve = "Pas trouvé"
End If
Next mot
' Copier la valeur associée en colonne H
data(i, 1) = motTrouve
Next i
' Écrire les résultats dans la colonne H
wsDonnees.Range("H2:H" & wsDonnees.Cells(wsDonnees.Rows.Count, "E").End(xlUp).Row).Value = data
' Réactiver les fonctionnalités désactivées
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub