Gestion de doublons

Cdsj Messages postés 9 Date d'inscription Statut Membre Dernière intervention -
yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention - 16 juin 2017 à 12:42

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

Version Excel : FR 2011 pour Mac

Afficher la suite

A voir également:

Gestion de doublons
Doublons photos - Guide
Logiciel gestion locative gratuit excel - Télécharger - Comptabilité & Facturation
Logiciel gestion photo gratuit - Guide
Gestion de fichiers - Télécharger - Gestion de fichiers
Gestion autorisation application android - Guide

1 réponse

Réponse 1 / 1

yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention Ambassadeur 1 584

suggestion:

if str0 <> wsi.Cells(i, 1) then
   str0 = str0 & " / " & wsi.Cells(i, 1)  
end if

Cdsj Messages postés 9 Date d'inscription Statut Membre Dernière intervention

Ca à l'air de fonctionner!! je l'adapte et te remercie d'avance!! cool

Cdsj Messages postés 9 Date d'inscription Statut Membre Dernière intervention

En fait, ça ne fonctionne qu'en partie, car ça ne me supprime que si les 1ères cellules sont identiques et se suivent.

Ça ne marche pas quand je retrouve le même contenu plus loin.

ça marche pour A / A / B / C --> A / B / C
mais pas pour A / B / C / A / B --> A / B / C / A / B

Donc je réitère ma demande afin que ça puisse le faire si c'est possible!.

Merci d'avance

yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention 1 584 > Cdsj Messages postés 9 Date d'inscription Statut Membre Dernière intervention

alors ainsi?

If InStr(str0 & " /", wsi.Cells(i, 1) & " /")  = 0 Then
   str0 = str0 & " / " & wsi.Cells(i, 1)
End If

Discussions similaires

application de gestion des contacts

Votre réponse

Discussions similaires