Comparaison de cellules avec séparateur

Function CompareText(Chaine1 As String, Chaine2 As String, Separateur As String) As String
Dim Tablo1, Tablo2, Tablo3() As String, i As Long, j As Long
    Tablo1 = Split(Chaine1, Separateur)
    Tablo2 = Split(Chaine2, Separateur)
    ReDim Tablo3(0)
    For i = LBound(Tablo1) To UBound(Tablo1)
        For j = LBound(Tablo2) To UBound(Tablo2)
            If LCase(Tablo1(i)) = LCase(Tablo2(j)) Then
                Tablo3(UBound(Tablo3)) = Tablo1(i)
                ReDim Preserve Tablo3(UBound(Tablo3) + 1)
            End If
        Next j
    Next i
    If UBound(Tablo3) > 0 Then ReDim Preserve Tablo3(UBound(Tablo3) - 1)
    CompareText = Join(Tablo3, Separateur)
End Function

=comparetext(A2;B2;", ")

Sub Test()
Dim DerLigne&, Tabl, Tabl2, Test, i&, j&, l&, Nb&
DerLigne = Sheets("Feuil1").Range("B" & Rows.Count).End(xlUp).Row
For i = 2 To DerLigne
    Nb = 0
    Tabl = Split(Sheets(1).Cells(i, 1), ",")
    Tabl2 = Split(Sheets(1).Cells(i, 2), ",")
        For j = LBound(Tabl) To UBound(Tabl)
            For k = LBound(Tabl2) To UBound(Tabl2)
                If Trim(Tabl(j)) = Trim(Tabl2(k)) Then
                    Dim tabl3()
                    ReDim Preserve tabl3(LBound(Tabl2) To UBound(Tabl2))
                    tabl3(Nb) = Tabl2(k): Nb = Nb + 1: Exit For
                End If
            Next k
        Next j
    Sheets("Feuil1").Cells(i, 3) = Left(Join(tabl3, ","), Len(Join(tabl3, ",")) - 1)
    For l = LBound(Tabl2) To UBound(Tabl2)
        tabl3(l) = ""
    Next l
 Next i
End Sub

Function CompareText(Chaine1 As String, Chaine2 As String, Separateur As String) As String
On Error Resume Next
Dim Tablo1, Tablo2, Tablo3() As String, i As Long
    Tablo1 = Split(Chaine1, Separateur)
    Tablo2 = Split(Chaine2, Separateur)
    ReDim Tablo3(0)
    For i = LBound(Tablo1) To UBound(Tablo1)
        If CVErr(Application.WorksheetFunction.Match(Tablo1(i), Tablo2, 0)) = CVErr(xlErrNA) Then GoTo 1
        Tablo3(UBound(Tablo3)) = Tablo1(i)
        ReDim Preserve Tablo3(UBound(Tablo3) + 1)
1   Next i
    If UBound(Tablo3) > 0 Then ReDim Preserve Tablo3(UBound(Tablo3) - 1)
    CompareText = Join(Tablo3, Separateur)
End Function