Macro Supprimer les lignes doublons

[lila]

ghkhhkjhhhhkhkhkh

 

[roro69]

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]

Re : Macro Supprimer les lignes doublons

bonjour,

voir aussi:

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]

Re : Macro Supprimer les lignes doublons

Bonsoir le forum,

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

 

[lila]

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.