nom en doublons

[luisf]

bonjour
j'ai un petit souci je charge une liste de nom dans une feuille sur la colonne A mais dans quelque cas j'ai 2 fois le meme nom dans la liste. je cherche le code vba pour suprimer la ligne ou apparait un nom en double
j'ai vu plusieur truc la dessus sur le forum mais je n'ai pas trouver comment faire.

merci

 

[Cousinhub]

Re : nom en doublons

Bonjour,
regarde du côté du filtre élaboré, avec extraction sans doublons

 

[luisf]

Re : nom en doublons

avec les filtres élaborer sa fonctionne mais il me faut le code vba pour supprimer la ligne si doublons car le filtre ne fais que masquer la ligne.

 

[Cousinhub]

Re : nom en doublons

Re-,
Ok, mais si tu extrais vers un autre emplacement, puis supprime ta colonne de départ?

 

[Guest]

Re : nom en doublons

Bonjour luisf, BHBH

Dans l'assistant Filtre élaboré, il y a une case à cocher 'Extraction sans doublons', il faut qu'elle soit cochée avant de valider.

Sinon Essaie avec ceci. Sauvegarder les données avant.
Les données sont triées sur la colonne A avant la suppression des lignes.

Sub SupprimerDoublons()
    Dim DerLigne As Long
    Dim nom As String
    Dim r As Range
    Dim i As Long

    DerLigne = Range("A" & Rows.Count).End(xlUp).Row
    With Range("A1:A" & DerLigne).CurrentRegion
        .Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _
              xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
              DataOption1:=xlSortNormal

        nom = .Cells(.Rows.Count, 1)
        For i = .Rows.Count - 1 To 1 Step -1
            If .Cells(i, 1) = nom Then .Cells(i).EntireRow.Delete
            nom = .Cells(i, 1)
        Next
    End With
End Sub

A bientôt

 

[Atlanx]

Re : nom en doublons

Bonjour,

j'avais utilisé ceci pour un problème similaire au tient, essaye le sur une copie de ton fichier.

Sub Supprimedoublon()

MaCellule = InputBox("Veuillez saisir l'adresse de la 1ere cellule à comparer")
Range(MaCellule).Select

ActiveCell.CurrentRegion.Sort Key1:=Range(MaCellule), Order1:=xlAscending, Header:=xlYes

donnee1 = ActiveCell
ActiveCell.Offset(1, 0).Select

While ActiveCell <> ""
If ActiveCell = donnee1 Then
ActiveCell.EntireRow.Delete
ActiveCell.Offset(-1, 0).Select
donnee1 = ActiveCell
ActiveCell.Offset(1, 0).Select
Else
donnee1 = ActiveCell
ActiveCell.Offset(1, 0).Select
End If
Wend

End Sub

 

[michel_m]

Re : nom en doublons

Bonjour à tous,

Pour alller dans le sens de bhbh: ci dessous
vers la colonne C, tri de la colonne A avec etiquette en A1

Sub Extraire_doublons()
Dim lig As Long

lig = Range("A2").End(xlDown).Row
Range("A1").AutoFilter
Range("A2:A" & lig).AdvancedFilter Action:=xlFilterCopy, Copytorange:=Range("C1"), Unique:=True
End Sub

 

[luisf]

Re : nom en doublons

avec les filtres sa marche mais je préfère avec le code car il faut que cela se fasse juste après que j'ai chargé la liste en cliquant sur le bouton.

par contre il y a une erreur a la ligne DataOption1:=xlSortNormal
argument nommé introuvable

 

[Cousinhub]

Re : nom en doublons

Re,
d'où l'utilité de mettre la version Excel utilisée......
Supprime cette partie de code

 

[BOISGONTIER]

Re : nom en doublons

Bonjour,

Sub supdoublonsSansModifOrdre()
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Set champ = Range("A2:A" & [A65000].End(xlUp).Row)
  For i = [A65000].End(xlUp).Row To 1 Step -1
    If Application.CountIf(champ, Cells(i, 1)) > 1 Then
        Cells(i, 1).Delete Shift:=xlUp ' ou Rows(i).Delete
    End If
  Next i
  Application.Calculation = xlAutomatic
End Sub

ou

Sub supDoublonsTradi()
   Application.ScreenUpdating = False 
   Application.Calculation = xlCalculationManual 
   [A1].Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess
   For i = [A65000].End(xlUp).Row To 2 Step -1
     If Cells(i, 1) = Cells(i - 1, 1) Then Rows(i).Delete
   Next i
   Application.Calculation = xlCalculationAutomatic 
End Sub

JB

 

[luisf]

Re : nom en doublons

Merci pour vos réponse
finalement j'ai opté pour la solution de michel m