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 |
Partager