Encore et toujours ces doublons

Bonjour à tous,

Je suis dans une impasse, j'ai grâce à ce forum progressé en vba, mais là je sèche et n'y arrive pas.

Voici mon code :

Sub DOUBLON()
    If MsgBox("Regrouper les doublons?", vbOKCancel, "Demande de Confirmation") = vbOK Then

    Set wsi = Worksheets(3)
    dli = wsi.Cells(Rows.Count, 15).End(xlUp).Row
    Set wso = Worksheets(4)
    dlo = 0
    rupt = ""
    For i = 1 To dli + 1
        If wsi.Cells(i, 15) <> rupt Then
            If rupt <> "" Then
                dlo = dlo + 1
                wso.Cells(dlo, 1) = str0
                wso.Cells(dlo, 2) = str1
                wso.Cells(dlo, 3) = str2
                wso.Cells(dlo, 4) = str3
                wso.Cells(dlo, 5) = str4
                wso.Cells(dlo, 6) = str5
                wso.Cells(dlo, 7) = str6
                wso.Cells(dlo, 8) = str7
                wso.Cells(dlo, 9) = str8
                wso.Cells(dlo, 10) = str9
                wso.Cells(dlo, 11) = str10
                wso.Cells(dlo, 12) = str11
                wso.Cells(dlo, 13) = str12
                wso.Cells(dlo, 14) = str13
                wso.Cells(dlo, 15) = rupt
            End If
            str0 = wsi.Cells(i, 1)
            str1 = wsi.Cells(i, 2)
            str2 = wsi.Cells(i, 3)
            str3 = wsi.Cells(i, 4)
            str4 = wsi.Cells(i, 5)
            str5 = wsi.Cells(i, 6)
            str6 = wsi.Cells(i, 7)
            str7 = wsi.Cells(i, 8)
            str8 = wsi.Cells(i, 9)
            str9 = wsi.Cells(i, 10)
            str10 = wsi.Cells(i, 11)
            str11 = wsi.Cells(i, 12)
            str12 = wsi.Cells(i, 13)
            str13 = wsi.Cells(i, 14)
            rupt = wsi.Cells(i, 15)

        Else
' C'est ici que je vois avoir besoin de vos conseils avisés
            str0 = str0 & " / " & wsi.Cells(i, 1)  
            str1 = str1 & " / " & wsi.Cells(i, 2)
            str2 = str2 & " / " & wsi.Cells(i, 3)
            str5 = str5 & " / " & wsi.Cells(i, 6)
            str6 = str6 & " / " & wsi.Cells(i, 7)
            str13 = str13 & " / " & wsi.Cells(i, 14)
        End If
    Next i
    wso.Columns("A:O").AutoFit
    wso.Select

    MsgBox (" Les doublons ont bien été supprimés !")
    MsgBox ("Attention, il ne reste plus qu'à vérifier le contenu des cellules A,B,C et F,G,H et de supprimer la dernière colonne")

    End If
End Sub

Les lignes sont regroupées et concaténées si les cellules de la colonne 15 sont identiques.

Je voudrais que le résultat de ces cellules ci :

            str0 = str0 & " / " & wsi.Cells(i, 1)  
            str1 = str1 & " / " & wsi.Cells(i, 2)
            str2 = str2 & " / " & wsi.Cells(i, 3)
            str5 = str5 & " / " & wsi.Cells(i, 6)
            str6 = str6 & " / " & wsi.Cells(i, 7)
            str13 = str13 & " / " & wsi.Cells(i, 14)

se fassent que lorsque le contenu est différent.

exemple

Ma base

1 2 3 ... 15

A D G ... AZ

B D H ... AZ

C F I ... AP

Ce que j'ai :

1 2 3 ... 15

A/B D/D G/H ... AZ

C F I ... AP

Ce que je voudrais :

1 2 3 ... 15

A/B D G/H ... AZ

C F I ... AP

Je ne sais pas si je suis assez clair? Merci de m'éclairer de vos lanternes.


La concaténation des cellules concernées doit dépendre si les cellules sont différentes.

Merci

J'ai oublié de vous préciser que je travaille sur Mac. l'idée du dico me plaisait bien, mais impossible pour moi donc.

Personne ne peut m'aider? je vois qu'il y a du passage!!

Rechercher des sujets similaires à "encore doublons"