Comparaison de cellules avec séparateur

[jmast]

Bonjour,

Voilà mon problème :
Je souhaiterai comparer deux cellules dans lesquelles se trouvent des chaines de caractère (avec comme séparateur une virgule).

En résultat je souhaiterai avoir, les termes qui sont égaux.

Exemple :
A2 : chat, chien, canard, oie
B2 : chat, canard, souris

==> C2 (résultat): chat, canard

Merci

 

[tototiti2008]

Re : Comparaison de cellules avec séparateur

Bonjour jmast,

dans un module :

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

en cellule C2

=comparetext(A2;B2;", ")

à recopier vers le bas

 

[david84]

Re : Comparaison de cellules avec séparateur

Bonjour,
à tester :

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

A+
Edit :bonjour Tototiti
Même principe que toi je pense mais tu l'as fait en fonction. Cela va me permettre d'analyser comment tu t'y es pris pour faire une fonction.

 

[Softmama]

Re : Comparaison de cellules avec séparateur

Bonjour,

En partant de la fonction personnalisée de tototiti2008 légèrement modifiée, pour obtenir le même résultat en ne réalisant qu'une seule boucle. (donc gain de temps si beaucoup de données à comparer, négligeable sinon)

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

 

[jmast]

Re : Comparaison de cellules avec séparateur

Je vous remercie pour vos réponses (toutes fonctionnelles).

Je l'adapterai à ma solution. Je reviendrai vers vous si j'ai un souci.

Merci encore