PB supprime doublons et non doublons

Bonjour,

J'ai un petit soucis au niveau de mon programme je pense, alors que je vous explique, je veux obtenir dans la colonne A les données sans doublons mais pour les doublons je veux que dans la colonne D on y ajoute la valeur de la cellule. lorsqu'il ya doublons rajouter la données du doublons de la colonne D dans la colonne D du 1er doublons et supprimer la ligne doublons.ca ca fonctionne mais ca me supprime aussi les lignes non doublons et je ne vous pas pourquoi c'est peut etre pas trés clair mais avec le fichier joint ca le sera un peu plus.

je vous remet le code aussi on sais jamais !

si vous avez une autre méthode ou que vous voyez pourquoi ca me donne pas ce que je souhaite je suis prennante !

bonne saint valentin à tous

Sub sup()

Dim dp As Integer, dp2 As Integer
'supprimer les doublons dans id et rajout dans dependtgates

                            For dp2 = 1 To Worksheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
                              For dp = 2 To Worksheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row - 1

                                    If Worksheets("Feuil1").Cells(dp2, 1).Value = Worksheets("Feuil1").Cells(dp, 1).Value Then

                                      dependentgates = Worksheets("Feuil1").Cells(dp2, 5).Value
                                      dependentgates = dependentgates & "," & Worksheets("Feuil1").Cells(dp, 5).Value
                                      Worksheets("Feuil1").Cells(dp2, 5).Value = dependentgates

                                      Worksheets("Feuil1").Rows(dp).EntireRow.Delete

                                    End If

                                Next dp

                                Next dp2

End Sub
23exempledoublon.xlsm (16.19 Ko)

Bonjour Sarah,

autant faire simple! Un petit bouton rouge à cliquer...

Quand tu veux supprimer des lignes dans une boucle, toujours parcourir de bas en haut pour éviter les mauvaises surprises!

Private Sub cmdGO_Click()
'
iRow = Range("A" & Rows.Count).End(xlUp).Row
Range("A2:E" & iRow).Sort key1:=Range("A2"), order1:=xlAscending
For x = iRow To 3 Step -1
    If Cells(x, 1) = Cells(x - 1, 1) Then
        Cells(x - 1, 5) = Cells(x - 1, 5) & ", " & Cells(x, 5)
        Rows(x).Delete shift:=xlUp
    End If
Next
Columns(5).AutoFit
'
End Sub

Avec plaisir!

A+

17sarahdoublons.xlsm (19.03 Ko)

salut ,

alors pour le bouton sur mon vrai fichier j'en ai un beaucoup plus tot dans mon programme je n'ai pas pensée a le remettre dans l'exemple.

je n'y avais pas pensée de partir de la fin je vais essayer ca. Par contre, je ne comprend pas pourquoi ca fonctionne avec qu'une seule boucle vu que ca compare que les cellule x et x-1 , je vois bien que ca fonctionne sur ton programme mais je ne comprend pas vraiment pourquoi

Bonjour,

Il a juste à comparer x avec x-1 car il trie au préalable les données dans l'ordre alphabétique :

Range("A2:E" & iRow).Sort key1:=Range("A2"), order1:=xlAscending

Bonjour,

@Sarah

Quand tu postes sur plusieurs forums, préviens...

Rechercher des sujets similaires à "supprime doublons"