suppression lignes en doublon

CAMPEN

XLDnaute Junior
Bonjour le forum,
Je cherche une macro me permettant de supprimer la ligne entière quand les cellules de la colonne S = 2 (suite à formule doublon).
Je joins le fichier en exemple.
 

Pièces jointes

  • doublon.xls
    22 KB · Affichages: 104
  • doublon.xls
    22 KB · Affichages: 107
  • doublon.xls
    22 KB · Affichages: 110

LPandre

XLDnaute Impliqué
Re : suppression lignes en doublon

Un code récupéré sur le forum :
(tu n'as plus besoin de ta colonne s)

Sub Macro_Doublon()
On Error GoTo fin
' Dans une sélection de cellule, met en rouge les cellules contenant des doublons
Set MonDico = CreateObject("Scripting.Dictionary")
Rep1 = InputBox("", "Qelle colonne est à contrôler ?")
If Rep1 = Cancel Then
Exit Sub
Else:
Colon$ = Rep1 ' <<<<<<<<<< colorer les doublons en colonne au choix !?
NoPremLig = 1 ' prem ligne
NoDernLig = Cells(Rows.Count, Colon$).End(xlUp).Row ' dern ligne
' boucle
For NoLig = NoPremLig To NoDernLig
If Cells(NoLig, Colon$) <> "" Then
Var$ = Cells(NoLig, Colon$)
If Not MonDico.Exists(Var$) Then ' ajoute
MonDico.Add Var$, Var$
Else ' sinon existe déjà
Cells(NoLig, Colon$).Interior.ColorIndex = 3 'soit rouge, le 4 = vert clair, etc.
End If
End If
Next
End If
' sélection des cellules contenant des données :
Range(Rep1 & 1 & ":" & Rep1 & NoDernLig).Select
' demande pour supprimer les doublons ou pas :
rep2 = MsgBox("Voulez vous supprimer les doublons", vbYesNo)
If rep2 = vbNo Then
GoTo toto
Else
Dim vCellule As Object
For i = 1 To 10
GoTo Boucle1
Boucle1:
For Each vCellule In Selection
Application.ScreenUpdating = False
If vCellule.Interior.ColorIndex = 3 Then vCellule.EntireRow.Delete
Next
Next
End If
Application.ScreenUpdating = True
toto:
' sélection de la cellule de la colonne avec doublon avant de sortir:
Range(Rep1 & 1).Select
fin:
End Sub


Tu peux même supprimer une partie du code si tu ne souhaites pas à avoir à confirmer la suppression :
' demande pour supprimer les doublons ou pas :
rep2 = MsgBox("Voulez vous supprimer les doublons", vbYesNo)
If rep2 = vbNo Then
GoTo toto
Else
 
Dernière édition:

laetitia90

XLDnaute Barbatruc
Re : suppression lignes en doublon

bonjour CAMPEN , LPandre

un code dans ce style dans ce cas precis.. peut être suffisant ??


Code:
Sub es()
Dim i As Long
Application.ScreenUpdating = False
For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If Range("s" & i) = 2 Then Rows(i).Delete
Next i
Range("S2").Select
Selection.AutoFill Destination:=Range("s2:s" & Cells(Rows.Count, 19).End(xlUp).Row)
End Sub
 

Discussions similaires

Réponses
26
Affichages
856
Réponses
22
Affichages
753
Réponses
6
Affichages
467
Réponses
1
Affichages
193

Membres actuellement en ligne

Statistiques des forums

Discussions
312 164
Messages
2 085 877
Membres
103 007
dernier inscrit
salma_hayek