Supprimer chaine identique d'une même cellule

Bonjour,

Je n'ai pas trouvé un meilleur titre et encore moins la solution à mon problème.

Voilà, en colonne C à partir de la ligne 7 à la dernière ligne non vide, dans chaque cellule il y 3 chaînes des caractères séparées par des renvois à la ligne (Chr(10)). Exemple: PPS28 & chr(10) & P120 & chr(10) & P120.

PPS28

P120

P120

En règle générale, c'est la 2ème et 3ème chaînes qui sont identiques. Je voudrais remplacer la 2ème chaîne par un renvoi à la ligne. c-à-d obtenir:

PPS28

P120

En espérant avoir bien énoncé mon problème. Dans le fichier joint, il y a un début de code et surtout le résultat escompté.

En vous remerciant par avance.

Bonjour,

une petite modification de ton code :

Private Sub CommandButton1_Click()
    Dim L As Integer, Plage As Range, Cell As Range
    L = ActiveSheet.Range("C" & Rows.Count).End(xlUp).Row
    Set Plage = Range("C7:C" & L)
    Dim tb
    Dim i As Integer
    Dim st As String
    For Each Cell In Plage
        tb = Split(Cell, vbLf)
        st = ""
        For i = 0 To UBound(tb) - 1
            If tb(i) <> tb(i + 1) Then st = st & tb(i) & vbLf Else st = st & vbLf
        Next
        Cell = st & tb(i)

    Next
End Sub

Bonjour,

une proposition

Option Explicit

Private Sub CommandButton1_Click()
    Dim L As Integer, Plage As Range, Cell As Range, a, i, j
    L = ActiveSheet.Range("C" & Rows.Count).End(xlUp).Row
    Set Plage = Range("C7:C" & L)
    For Each Cell In Plage
      a = Split(Cell, Chr(10))
      For i = UBound(a) To LBound(a) + 1 Step -1
       For j = i - 1 To LBound(a) Step -1
        If a(i) = a(j) Then a(j) = ""
       Next j
      Next i
      Cell.Offset(, 2) = Join(a, Chr(10))
    Next
End Sub

Bonjour à tous,

Et une nouvelle proposition, une.

Cdlt.

Option Explicit
Dim rngData As Range, Cell As Range
Dim lRow As Long

Private Sub CommandButton1_Click()
Dim tbl As Variant
    Application.ScreenUpdating = False
    With Me
        lRow = .Cells(Rows.Count, "C").End(xlUp).Row
        Set rngData = Range("C7:C" & lRow)
        For Each Cell In rngData
            tbl = Split(Cell, Chr(10))
            If tbl(1) = tbl(0) Or tbl(2) = tbl(1) Then
                Cell.Offset(0, 2).Value = tbl(0) & Chr(10) & Chr(10) & tbl(2)
                Else
                Cell.Offset(0, 2) = Cell.Value
            End If
        Next
    End With
    Set rngData = Nothing

End Sub

Private Sub CommandButton2_Click()
    Application.ScreenUpdating = False
    With Me
        lRow = .Cells(Rows.Count, "E").End(xlUp).Row
        Set rngData = Range("E7:E" & lRow)
        rngData.Cells.ClearContents
    End With
    Set rngData = Nothing
End Sub

Merci, merci merci beaucoup.

@pierre.jy: ton code est parfait, c'est exactement ce que je voulais. Merci beaucoup.

@ h2so4: je te remercie, mais le code ne donne rien.

@Jean-Eric: Ton code répond bien à mon problème, sauf que le résultat doit être dans la même colonne. Merci beaucoup, je pourrai corriger pour renvoyer les résultats dans la même colonne.

Merci à vous. Toue ma reconnaissance.

Re,

Si il n'y a que cela (c'était pour les tests. ).

Cdlt.

Option Explicit
Dim rngData As Range, Cell As Range
Dim lRow As Long

Private Sub CommandButton1_Click()
Dim tbl As Variant
    Application.ScreenUpdating = False
    With Me
        lRow = .Cells(Rows.Count, "C").End(xlUp).Row
        Set rngData = Range("C7:C" & lRow)
        For Each Cell In rngData
            tbl = Split(Cell, Chr(10))
            If tbl(1) = tbl(0) Or tbl(2) = tbl(1) Then
                Cell.Value = tbl(0) & Chr(10) & Chr(10) & tbl(2)
            End If
        Next
    End With
    Set rngData = Nothing

End Sub

Private Sub CommandButton2_Click()
    Application.ScreenUpdating = False
    With Me
        lRow = .Cells(Rows.Count, "E").End(xlUp).Row
        Set rngData = Range("E7:E" & lRow)
        rngData.Cells.ClearContents
    End With
    Set rngData = Nothing
End Sub
 

Trop gentil Jean-Eric, merci encore. Mais je t'avais dit que je pouvais corriger.

Un grand merci.

CP4 a écrit :

@ h2so4: je te remercie, mais le code ne donne rien.

donne le résultat en colonne E.

h2so4 a écrit :

CP4 a écrit :

@ h2so4: je te remercie, mais le code ne donne rien.

donne le résultat en colonne E.

Ah, tu m'as eu. Je ne pouvais pas deviner. Tu as choisi la colonne du résultat escompté.

Merci beaucoup. Maintenant, j'ai l'embarras du choix. Mais j'ai déjà adopté un code.

Je garde toujours les codes qu'on me propose. J'essaie de les comprendre et je les archives à toutes fins utiles.