• Initiateur de la discussion Initiateur de la discussion luisf
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

luisf

XLDnaute Occasionnel
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
 
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.

Code:
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
 
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
 
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
Code:
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
 
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
 
Re : nom en doublons

Bonjour,


Code:
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
Code:
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
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
11
Affichages
632
Réponses
10
Affichages
417
Réponses
2
Affichages
290
Réponses
16
Affichages
698
Retour