Comparer 2 colonnes de texte

Bonjour,

Je suis nouvelle sur le forum. Cela fait quelques jours que je planche sur ce problème sans trouver la solution, donc j'espère que vous pourrez m'aider !

J'ai un fichier avec 2 feuilles.

Chaque cellule de la colonne A de la Feuil1 contient 1 ou plusieurs mots.

Chaque cellule de la colonne D de la Feuil2 contient 1 ou plusieurs mots.

Pour chaque cellule de la colonne A de la Feuil1, je souhaite comparer chaque mot de la cellule avec ceux contenus dans les cellules de la colonne D de la Feuil2. S'il y a une correspondance, il faut recopier dans la colonne B de la Feuil1 la donnée contenue dans la colonne E de la Feuil2.

J'espère que c'est clair !

D'avance merci

1000N

Bonsoir,

C'est clair mais :

• Peut-il y avoir plusieurs solutions de recherche (trouver A plusieurs fois dans D) ? Et si oui ou mettre les autres occurences trouvées ?
• Un fichier (même avec données partielles) serait le bien venu !

Bonjour,

Je te conseille ce fil :

https://forum.excel-pratique.com/post386718.html?hilit=Comparer#p386718

Bonne soirée,

VBABEGINNER

Bonjour,

Voici le fichier avec une partie des données. Les "mots" en question sont en réalité composés d'une lettre + une série de chiffre.

Effectivement, il y a peut être plusieurs solutions de recherche. Dans ce cas, on pourrait mettre les autres données collectées dans une colonne inutilisée.

Merci,

Bonjour à toutes et à tous.

Sub analyse()
    a = Feuil1.UsedRange
    b = Feuil2.UsedRange
    ReDim d(UBound(a))
    n = 0
    For i = 2 To UBound(a)
        c = Split(a(i, 1), ",", , vbTextCompare)
        For j = 0 To UBound(c)
            For k = 2 To UBound(b)
                If InStr(1, b(k, 4), c(j), vbTextCompare) > 0 Then d(n) = b(k, 5)
            Next
        Next
        n = n + 1
    Next
    Feuil1.[B2].Resize(UBound(d)) = Application.Transpose(d)
End Sub

ou

Sub analyse()
    a = Feuil1.UsedRange
    B = Feuil2.UsedRange
    ReDim d(UBound(a), 1)
    n = 0
    For i = 2 To UBound(a)
        c = Split(a(i, 1), ",", , vbTextCompare)
        For j = 0 To UBound(c)
            For k = 2 To UBound(B)
                If InStr(1, B(k, 4), c(j), vbTextCompare) > 0 Then
                    d(n, 0) = c(j): d(n, 1) = B(k, 5)
                End If
            Next
        Next
        n = n + 1
    Next
    With Feuil3
    .[A2].Resize(UBound(d), 2) = d
    .UsedRange.Cells.SpecialCells(xlCellTypeBlanks).Delete shift:=xlUp
    End With
End Sub

Super, ça marche !

Merci beaucoup