VBA - Extraire les différences entre deux cellules

Bonjour à tous,

J'ai une question pour vous,

J'aimerais savoir s'il est possible d'extraire les différence entre 2 cellules et eventuellement en modifiant la couleur en fonction des différences.

Dans mon fichier j'ai une colonne A où on a un état initial, les valeurs y sont de type isocode (+FR, +US) et une colonne C ou on a un état final dans lequel il peut y avoir des isocodes en plus ou en moins.

L'idée serait de mettre en B, en rouge les isocodes qui ont été supprimés et en vert ceux qui ont été rajoutés. (Comme ci dessous)

J'ai déjà essayé de comparer caractère par caractère, mais comme il peut y avoir des isocode en plus ou en moins ça ne marche pas, de même que pour Substitue()

Merci d'avance pour vos réponse,

Cordialement,

Dino

bonjour

une proposition (partielle) via une fonction personnalisée.

appel de la fonction en excel

=différence(A1,B1) ou A1 et B1 sont respectivement chaîne de départ et chaîne finale

Function différence(texte1, texte2)
    t1 = Split(texte1, ",")
    t2 = Split(texte2, ",")
    For i = LBound(t1) To UBound(t1)
        If InStr(texte2, t1(i)) = 0 Then enmoins = enmoins & t1(i) & ","
    Next i
    For i = LBound(t2) To UBound(t2)
        If InStr(texte1, t2(i)) = 0 Then enplus = enplus & t2(i) & ","
    Next i
    différence = IIf(enmoins <> "", Left(enmoins, Len(enmoins) - 1) & " (-)", "") & IIf(enplus <> "", Left(enplus, Len(enplus) - 1) & " (+)", "")
End Function

indique avec (-) ce qui a été enlevé et avec (+) ce qui a été ajouté.

pour mettre les couleurs, il faudra passer par une procédure VBA

Bonjour h2so4,

Merci beaucoup pour ta solution, c'est parfait pour moi.

Je rajoute le code que j'ai fait pour mettre en couleur et supprimer les "(+)" et "(-)"

Sub mettreencouleur()
    Dim xRg1 As Range
    Dim xRg2 As Range
    Dim xCell1 As Range
    Dim xCell2 As Range
    Dim I As Long
    Dim J As Integer
    Dim K As Integer
    Dim xLen As Integer

    Set xRg1 = Range("B2:B5")
    Set xRg2 = Range("C2:C5")

    For I = 1 To xRg1.Count
        Set xCell1 = xRg1.Cells(I)
        Set xCell2 = xRg2.Cells(I)

        xCell2.Value = xCell1.Value

                    xLen = Len(xCell1.Value)
                    For J = 1 To xLen
                        If xCell2.Characters(J, 3).Text = ("(+)") Then
                            xCell2.Characters(J, 6).Font.Color = vbGreen
                        End If
                        If xCell2.Characters(J, 3).Text = ("(-)") Then
                            xCell2.Characters(J, 6).Font.Color = vbRed
                        End If
                        If xCell2.Characters(J, 1).Text = "," Then
                            xCell2.Characters(J, 1).Font.Color = vbBlack
                        End If
                        If xCell2.Characters(J, 3).Text = ("(-)") Then
                            xCell2.Characters(J, 3).Delete
                        End If
                        If xCell2.Characters(J, 3).Text = ("(+)") Then
                            xCell2.Characters(J, 3).Delete
                        End If

                    Next J

    Next I

    Application.ScreenUpdating = True
End Sub

Je pense qu'il existe mieux, mais ça marche pour moi !

Merci encore

Dino