Macro Supprimer les lignes doublons

roro69

XLDnaute Impliqué
Re : Macro Supprimer les lignes doublons

Bonsoir
Essaye ceci:
Sub supprimeDoublons()
Dim cellulecourante As Range
Dim cellulesuivante As Range
Set cellulecourante = ActiveSheet.Range("A133")

ActiveSheet.Range("A133").Sort Key1:=Range("A133"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Do While Not IsEmpty(cellulecourante) = True
Set cellulesuivante = cellulecourante.Offset(1, 0)
If cellulesuivante.Value = cellulecourante.Value Then
cellulecourante.EntireRow.Delete
End If
Set cellulecourante = cellulesuivante
Loop
End Sub

A++
 

Roland_M

XLDnaute Barbatruc
Re : Macro Supprimer les lignes doublons

bonjour,

voir aussi:
Code:
Sub DictionarySupprLignDoublon()
Application.ScreenUpdating = False
Dim mondico As Variant: Set mondico = CreateObject("Scripting.Dictionary")
NoPremLig = 2 'prem ligne de départ
NoDernLig = Cells(Rows.Count, "A").End(xlUp).Row 'dern ligne en colonne A
'
NoLig = NoPremLig
Do While NoLig <= NoDernLig
   If Cells(NoLig, "A") <> "" Then
      Var$ = Cells(NoLig, "B") & Cells(NoLig, "C") & Cells(NoLig, "D")
      If Not mondico.Exists(Var$) Then 'ajoute
         mondico.Add Var$, Var$: NoLig = NoLig + 1
      Else 'suppr car existe déjà
         Rows(NoLig).EntireRow.Delete
      End If
   Else
      NoLig = NoLig + 1
   End If
Loop
Set mondico = Nothing
Application.ScreenUpdating = True
End Sub
 

laurent950

XLDnaute Accro
Re : Macro Supprimer les lignes doublons

Bonsoir le forum,

VB:
Sub Test()
 
Dim t() As Variant
 
f = Range("a65536").End(xlUp).Row

' Tableau en mémoire :
 t = Range(Cells(133, 1), Cells(f, 2))

 ' Suppresion de la zone (toutes les données qui sont en mémoire)
 Range(Cells(133, 1), Cells(f, 2)).Clear
 
 ' Redimension du tabeau pour les clefs (colone en mémoire 3 = concatenantion et 4 = Nombre 1 si doublon)
 ReDim Preserve t(1 To UBound(t), 1 To 4)
 
 For i = 1 To UBound(t, 1)
 t(i, 3) = t(i, 1) & t(i, 2)
 x = i + 1
 For j = x To UBound(t, 1)
 t(j, 3) = t(j, 1) & t(j, 2)
 If t(i, 3) = t(j, 3) Then
 t(j, 4) = t(j, 4) + 1
 End If
 Next j
 Next i

' Tableau 2 ou seront stoker les données en mémoire (avec les meme dimension que le tableau supprimer)
Dim t2() As Variant
ReDim t2(1 To UBound(t), 1 To 2)

cpt = 1
For i = 1 To UBound(t, 1)
 If t(i, 4) = Empty Then    ' Si la colonne 4 du premier tableau "t" est vide la ligne est unique
 t2(cpt, 1) = t(i, 1) ' transfert des cases d'un tableau a l'autre ici case 1 de la ligne i dans le tableau mémoire
 t2(cpt, 2) = t(i, 2)  ' transfert des cases d'un tableau a l'autre ici case 2 de la ligne i dans le tableau mémoire
 cpt = cpt + 1         ' ici compteur pour remplir le nouveau tableau "t2"
 End If
 Next i
 

' ici reconstituer le tableau sans doublon = colle le tableau 2 "t2" a l'endroit de celui supprimer
 Cells(133, 1).Resize(UBound(t2, 1), UBound(t2, 2)) = t2
  
 End Sub

laurent
 

Pièces jointes

  • DoublonsOcobre2012.xlsm
    20.2 KB · Affichages: 206
Dernière édition:

lila

XLDnaute Nouveau
Re : Macro Supprimer les lignes doublons

Merci à vous,

La macro qui semble le plus adaptée à mon cas est celle de Laurent.

Elle fonctionne très bien sauf que maintenant j'ai un autre problème qui est : les cellules de la colonne A sont en fait des formules contenant des références vers d'autre feuille et qui changent en fonction du changement du contenu d'une cellule.

Donc lorsque j'applique la macro elle supprime effectivement les lignes doublons mais mes cellules ne sont plus des formules mais du texte seulement.

Comment puis-je l’adapter.

Encore Merci à tous.

Lila.
 

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 846
dernier inscrit
Silhabib