Fonction supprimer les doublons ou autre du même genre

[pierreg]

Bonjour,

Y a t-il une formule ou une fonction spécifique pour enlever les doubles en ne gardant que les valeurs qui ne sont pas des doublons.
Exemple:
1
2
2
3
3
4

Je désire garder seulement:
1
4

Si j'utilise la fonction supprimer les doublons, il me supprime les doublons mais garde
1
2
3
4
Ca ne convient pas.

Merci

 

[pierreg]

Re : Fonction supprimer les doublons ou autre du même genre

Petite question à pierrejean.
Comment faire pour augmenter le nombre de valeurs à traiter?
Je n'ai aucune idée du fonctionnement des macros, mes tableaux ont plusieurs milliers de références, je ne sais pas comment augmenter le champs d'action.
Y-a t-il moyen de paramétrer le fichier pour au moins 100 000 valeurs?
Merci d'avance.

 

[CISCO]

Re : Fonction supprimer les doublons ou autre du même genre

Bonsoir à tous

Si je comprend bien la macro proposée par pierrejean, elle commence par le bas de la feuille, en ligne 65536, et remonte au fur et à mesure. Si tu as une version d'excel supportant plus de lignes, remplace cette valeur , 65536 dans sa macro (Accès aux macros avec Alt+F11) par un nombre supérieur au nombre de lignes max de ton fichier.

Attention, cette macro hypersimple ne fonctionne que si les répétitions sont classées les unes en dessous des autres, à la suite, et non un peu au hasard dans ton fichier.

@ plus

 

[pierreg]

Re : Fonction supprimer les doublons ou autre du même genre

Merci pour ces explications Cisco, je prend note de ces infos importantes. Je pense en effet que je n'avais pas trié les doubles ensemble.
😱

 

[pierrejean]

Re : Fonction supprimer les doublons ou autre du même genre

Re

Salut et merci CISCO

Pour Excel 2010 remplacer la macro par:

Sub suppr()
For n = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
If Range("A" & n) = Range("A" & n - 1) Then
   Rows(n - 1 & ":" & n).Delete
 End If
Next n
End Sub

Je me souviens par ailleurs avoir bien precisé que le tableau devait etre prealablement trié sur la colonne A
D'autre part s'il devait y avoir plus de 2 identiques il conviendrait de lancer la macro une ou plusieurs fois supplementaire
Compte tenu de la vitesse d'execution , c'est je pense la meilleure methode mais je suis pret à envisager le cas de façon plus generale

 

[pierrejean]

Re : Fonction supprimer les doublons ou autre du même genre

Re

En fait voici une version
Adaptée à autant de lignes qu'il en est possible avec xl 2010
Qui ne necessite pas de tri
Qui traite autant de doublons qu'il en existe
Qui devrait deja etre très rapide ,mais qu'il est possible de doper encore un peu plus

A tester donc (et me tenir au courant S.V.P)

 

[BOISGONTIER]

Re : Fonction supprimer les doublons ou autre du même genre

Bonjour,

Voir PJ

-Conserve la présentation

Sub SupDoublonsRapideColAConservePrésentation()
  Application.ScreenUpdating = False
  Set f1 = Sheets("feuil1")
  a = f1.Range("A1:A" & [A65000].End(xlUp).Row)
  Set mondico = CreateObject("Scripting.Dictionary")
  For i = LBound(a) To UBound(a)
    mondico(a(i, 1)) = mondico(a(i, 1)) + 1
  Next i
  For i = LBound(a) To UBound(a)
    If mondico(a(i, 1)) < 2 Then a(i, 1) = 0 Else a(i, 1) = "sup"
  Next
  Columns("b:b").Insert Shift:=xlToRight
  [B1].Resize(UBound(a)) = a
  [A1].CurrentRegion.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo
  On Error Resume Next
  Range("B2:B65000").SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
  Columns("b:b").Delete Shift:=xlToLeft
End Sub

-Ne conserve pas la présentation

Sub SupDoublonsColASansPrésentation()
  Application.ScreenUpdating = False
  Set f1 = Sheets("feuil1")
  a = f1.Range("A1").CurrentRegion.Value
  Set mondico = CreateObject("Scripting.Dictionary")
  For i = LBound(a) To UBound(a)
    mondico(a(i, 1)) = mondico(a(i, 1)) + 1
  Next i
  Dim c()
  ReDim c(1 To UBound(a, 1), 1 To UBound(a, 2))
  ligne = 1
  For i = LBound(a) To UBound(a)
    If mondico(a(i, 1)) < 2 Then
      For k = LBound(a, 2) To UBound(a, 2): c(ligne, k) = a(i, k): Next k
      ligne = ligne + 1
    End If
  Next
  Sheets("feuil2").[A1].Resize(mondico.Count, UBound(a, 2)) = c
End Sub

Sup rapide de doublons

JB

 

[pierrejean]

Re : Fonction supprimer les doublons ou autre du même genre

Re

@ JB

Si je peux me permettre:

a = f1.Range("A1:A" & [A65000].End(xlUp).Row)

a remplacer par

a = f1.Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)

pour aller au dela de 65000 lignes (pierreg parle de 100 000 lignes)

 

[david84]

Re : Fonction supprimer les doublons ou autre du même genre

Bonjour à tous,
à tester :

Sub test()
Dim T()
  Application.ScreenUpdating = False
  a = Sheets("feuil1").[A1].CurrentRegion
  Set mondico = CreateObject("Scripting.Dictionary")
  For i = LBound(a, 1) To UBound(a, 1)
    mondico(a(i, 1)) = mondico(a(i, 1)) + 1
  Next i
  For i = LBound(a) To UBound(a)
    If mondico(a(i, 1)) < 2 Then
        ReDim Preserve T(mondico.Count, UBound(a, 2))
        For j = LBound(a, 2) To UBound(a, 2)
            T(k, j - 1) = a(i, j)
        Next j
        k = k + 1
    End If
  Next
  [A1].CurrentRegion.ClearContents
  [A1].Resize(UBound(T), UBound(T, 2)) = T
End Sub

A+

 

[pierreg]

Re : Fonction supprimer les doublons ou autre du même genre

Bonjour à tous,
Merci pour ces nouveaux fichiers qui vont m'être très utiles et qui j'espère pourront aider d'autres personnes.
J'avais gardé comme fichier pour mes applications la 1ere version de pierrejean même si il est vrai qu'il fallait plusieurs minutes pour traiter les près de 100000 lignes à exécuter.
Du coup, je reprend ces nouveaux fichiers que je viens de tester, malheureusement j'ai une erreur d’exécution (avec le dernier fichier de pierrejean) et visual basic qui s'ouvre m'annonçant un dépassement de capacité. Il me demande si je veux déboguer et me surligne cette ligne
If CInt(tabres(n)) > CInt(tabres(m)) Then
Je précise que la ligne "a = f1.Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)" est bien présente, je suppose que pierrejean avait bien modifié son fichier.


Concernant le fichier de BOISGONTIER, ca marche super, et en effet c'est très rapide, formidable,
merci à tous.

 

[pierrejean]

Re : Fonction supprimer les doublons ou autre du même genre

Re

Pour le fun (Effectivement les macros de JB sont sans aucun doute plus efficaces que les miennes)

remplacer:

If CInt(tabres(n)) > CInt(tabres(m)) Then

par

If Clng(tabres(n)) > Clng(tabres(m)) Then

 

[pierreg]

Re : Fonction supprimer les doublons ou autre du même genre

Désolé, je ne voulais vraiment pas créer de polémique, je ne sais pas qu'elles sont les macros les plus efficaces mais le fait de pouvoir en faire est pour le moment au dessus de mes possibilités! Et je ne pense pas que la qualité se mesure seulement à cela en tous les cas j'ai bien été content de vous trouver et les macros bonnes ou moins bonnes je les prends 🙂
Merci

 

[pierrejean]

Re : Fonction supprimer les doublons ou autre du même genre

Re

Rassures-toi : Il n'y a pas de polemique , pas plus que de macros bonnes ou moins bonnes (simplement plus ou moins adaptées au problème )

 

[superbog]

Re : Fonction supprimer les doublons ou autre du même genre

c'est génial mais ca ne marche que si les doublons sont l'un sous l'autre. comment adapter cette macro pour des doublons qui peuvent se trouver éloignés l'un de l'autre???
et comment faire pour effacer les cellules concernées, pas les supprimer?