Garder les doublons et supprimer les références uniques

[Boby71C]

Bonjour à tous
Je ne suis pas comme tout le monde, d' habitude, nous cherchons à supprimer les doublons et moi, c'est l'inverse.

J'ai un fichier de plusieurs miliers de lignes dans lequel je désir garder les lignes dont les références figurent plusieurs fois et supprimer les lignes qui apparaissent une seul foi.
ex:
A
A
A
B
C
C
D

dans ce cas de figure, je garde TOUTES les références A et CJe supprime les référence B et D.

Merci pour votre aide
@+

 

[skoobi]

Re : Garder les doublons et supprimer les références uniques

Bonjour,

une question: est-ce que la liste est triée? Ca sera plus facile à faire et surtout plus rapide (enfin j'éspère ) vu le nombre de lignes.

 

[suistrop]

Re : Garder les doublons et supprimer les références uniques

Bonjour,

une question: est-ce que la liste est triée? Ca sera plus facile à faire et surtout plus rapide (enfin j'éspère ) vu le nombre de lignes.

ca c est clair....

sinon dans un cas non trié essai ca :

Sub test()
For i = 1 To Range("A65536").End(xlUp).Row
    nom = Cells(i, 1)
    For y = 1 To Range("A65536").End(xlUp).Row
        If nom = Cells(y, 1) Then
            cpt = cpt + 1
        End If
    Next y
    If cpt < 2 Then
        For z = 1 To Range("A65536").End(xlUp).Row
            If Cells(z, 1) = nom Then
                Rows(z).Select
                Selection.Delete Shift:=xlUp
                i = i - 1
            End If
        Next z
    End If
    cpt = 0
Next i
End Sub

PS : je pense qu on peut pas faire plus long

 

[Boby71C]

Re : Garder les doublons et supprimer les références uniques

Bonjour Skoobi
Merci de me répondre.
La liste est triée par référence, mais il peut y avoir les doublons se suivent.
Ex:
A
B
B
C
D
E
E
F
F
G
etc..

Merci
@+

 

[Guest]

Re : Garder les doublons et supprimer les références uniques

bonjour à tous,

Une proposition:

Sub supprimerUniques()
 Dim plage As Range
 Dim Ligne As Long, cpt As Long
 On Error GoTo FinSuppr
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
 With Sheets("Feuil3")
    Set plage = .Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row)
    cpt = plage.Rows.Count
    For Ligne = cpt To 1 Step -1
        If Application.CountIf(plage, plage.Cells(Ligne, 1)) = 1 Then
           plage.Cells(Ligne, 1).EntireRow.Delete
        End If
    Next Ligne
 End With
FinSuppr:
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True
End Sub

Chez moi 4 secondes pour 7443 lignes

 

[Boby71C]

Re : Garder les doublons et supprimer les références uniques

Bonjour à tous
Les deux méthodes fonctionnent.

Merci beaucoup pour votre aide.
Vous m'enlevez un sérieuse épine du pieds.

Bon Weekend à tous

 

[Pierrot93]

Re : Garder les doublons et supprimer les références uniques

Bonjour à tous

une autre solution, comme c'est fait je donne...

Sub test()
Dim x As Long, l As Long, c As Range
Application.ScreenUpdating = False
x = Range("A65536").End(xlUp).Row
For l = x To 1 Step -1
    Set c = Range("A1:A" & x).Find(Range("A" & l).Value, Range("A" & l), xlValues, xlWhole, , , False)
    If c.Row = l Then Rows(l).Delete
Next l
Application.ScreenUpdating = True
End Sub

bon après midi
@+

 

[skoobi]

Re : Garder les doublons et supprimer les références uniques

Re,

salut suistrop, Hasco Pierrot ,

tant qu'on y est, voici ma proposition:

'cette macro supprime la ligne d'une référence unique (la liste doit être triée)
Sub del_unique2()
t = Timer
Application.ScreenUpdating = False
Set plage = Rows(65536)
lig = 1
derlig = [A65536].End(xlUp).Row
Do While lig <= derlig
  nbre = Application.WorksheetFunction.CountIf(Range([A1], [A1].End(xlDown)), Range("A" & lig))
  If nbre = 1 Then Set plage = Union(plage, Rows(lig))
  lig = lig + nbre
Loop
plage.Delete
Application.ScreenUpdating = True
Debug.Print Timer - t
End Sub

La durée peut varier fortement en fonction du pourcentage de référence unique à supprimer.

 

[Guest]

Re : Garder les doublons et supprimer les références uniques

Salut tous,
Salut Skoobi

@Skoobi, connais-tu les limites de Union. J'avais bien pensé à une telle solution mais je n'en connais pas les limites?

Merci

A+

 

[skoobi]

Re : Garder les doublons et supprimer les références uniques

Salut tous,
Salut Skoobi

@Skoobi, connais-tu les limites de Union. J'avais bien pensé à une telle solution mais je n'en connais pas les limites?

Merci

A+

Non, aucune idée, je dirais la mémoire du PC ?

 

[BOISGONTIER]

Re : Garder les doublons et supprimer les références uniques

Bonjour,


Avec le filtre élaboré sans VBA:


JB

 

[Guest]

Re : Garder les doublons et supprimer les références uniques

Hello boisGontier

C'est si simple!

La question est "Pourquoi faire simple quand on peut faire compliqué?"

arf...arf... comme dirai notre ami JC

 

[jeanpierre]

Re : Garder les doublons et supprimer les références uniques

Bonsoir tous,

Pour les doublons, j'ai essayé Arf Arf, mais cela de fait rien, la solution de Jacques BOISGONTIER est très bonne.

 

[Boby71C]

Re : Garder les doublons et supprimer les références uniques

Bonsoir à tous
Merci pour toutes vos propositions.
Le filtre élaboré de boisGontier va pas car il supprime également les doublons alors que je dois impérativement garder les deux références identiques.
Merci quand même pour ton aide car pas plus tard que cette semaine, j'ai dit à mon chef de service qu'il faudrait que je me penche sur le sujet car je suis un accro d'excel mais je ne connais pas les filtres élaborés.

Merci à tous et excellent Week end

 

[BOISGONTIER]

Re : Garder les doublons et supprimer les références uniques

>Le filtre élaboré de boisGontier va pas car il supprime également les doublons alors que je dois impérativement garder les deux références identiques.

Il suffit de ne pas cocher extraction sans doublons


JB