Faire ressortir seulement les Doublons

Bonjour à toutes et à tous,

J'ai un problème, j'ai un fichier qui comporte environ 7000 lignes et une 12aine de colonnes, je souhaiterai garder dans ce fichier seulement les lignes où l'adresse mail est identique au moins 2 fois, c'est à dire quand il y a une adresse mail identique dans 2 lignes différentes au moins(il y a une colonne qui comporte seulement les adresses mail).

Je ne m'y connais pas du tout en macro.

Je vous joint un extrait de mon fichier.

Un grand merci d'avance pour votre aide.

Bien à vous,

Florian

Bonjour, avec la fonction Données/Trier peut-être en sélectionnant la plage? a+

Bonjour,

Menu données/Supprimer les doublons et tu choisis la colonne pour laquelle tu ne veux que des références uniques.

P.

Robinet a écrit :

Bonjour, avec la fonction Données/Trier peut-être en sélectionnant la plage? a+

Su 10 ou 20.000 lignes ça risque d'être fastidieux

P.

Bonjour,

merci pour votre retour, mais je ne souhaite pas les supprimer, au contraire je veux les garder.

Il est possible d'avoir plus d'info sur la fonction tri ? comment dois-je procéder, je n'y arrive .

Merci

Bonjour,

Dans une colonne supplémentaire, si tu veux toutes les lignes :

=NB.SI(F:F;F1)>1

si tu ne veux que la 1ère apparition :

=ET(NB.SI(F:F;F1)>1;EQUIV(F1;F:F;0)=LIGNE())

Trier et supprimer les FAUX

eric

Bonsoir le forum,

Ce qui revient à supprimer les "uniques" si j'ai bien compris

A tester :

Option Explicit

Sub test()
Dim r As Range, rng As Range, x As Range, e, w()
Set rng = Range("a1").CurrentRegion
    rng.Interior.ColorIndex = -4142
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For Each r In Range("f1", Range("f" & Rows.Count).End(xlUp))
            If Not .exists(r.Value) Then
                .Item(r.Value) = VBA.Array(1, r.Row)
            Else
                w = .Item(r.Value)
                w(0) = w(0) + 1
                .Item(r.Value) = w
            End If
        Next
        For Each e In .keys
            If .Item(e)(0) = 1 Then
                If x Is Nothing Then
                    Set x = Range(Cells(.Item(e)(1), 1), Cells(.Item(e)(1), 20))
                Else
                    Set x = Union(x, Range(Cells(.Item(e)(1), 1), Cells(.Item(e)(1), 20)))
                End If
            End If
        Next
    End With
    If Not x Is Nothing Then x.Interior.ColorIndex = 45 'surligne
    'If Not x Is Nothing Then x.EntireRow.Delete 'supprime
    'If Not x Is Nothing Then x.Select 'selectionne
    Set rng = Nothing
    Set x = Nothing
End Sub

klin89

Bonjour Klin89 , oui voila c'est exactement sa, je souhaite supprimer les uniques

Comment dois-je tester ce que vous m'avez envoyé ? avec un macro ?

Désolé je ne suis vraiment pas doué la dedans , qu'elle procédure dois-je réaliser ?

un grand merci

Bonjour,

à partir d'e ton classeur XL:

ALT-F11

Insertion/Module et coller le texte de Klin89 (que je salue ) et ensuite il y a une petite flèche bleue vers la droite, tu cliques dessus ou tu presses F5 et le code se lancera.

A tester sur une feuille d'essai toujours

P.

Re florianmonot,

Oui patrick, par précaution on pourrait restituer le résultat sur une autre feuille.

Ici restitution en Feuil2, feuille préalablement créée.

Option Explicit

Sub test()
Dim a, i As Long, w()
    a = Sheets("Feuil1").Range("a1").CurrentRegion.Value
    ReDim Preserve a(1 To UBound(a, 1), 1 To UBound(a, 2) + 1)
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 1 To UBound(a, 1)
            If Not .exists(a(i, 6)) Then
                .Item(a(i, 6)) = VBA.Array(a(i, 6), 1)
            Else
                w = .Item(a(i, 6))
                w(1) = ""
                .Item(a(i, 6)) = w
            End If
        Next
        For i = 1 To UBound(a, 1)
            If .exists(a(i, 6)) Then
                w = .Item(a(i, 6))
                a(i, 21) = w(1)
                .Item(a(i, 6)) = w
            End If
        Next
        'restitution en Feuil2
        With Sheets("Feuil2").Range("a1")
            .Parent.Cells.Clear
            .Resize(UBound(a, 1), UBound(a, 2)).FormulaLocal = a
            With .CurrentRegion
                .Columns("U").SpecialCells(4).EntireRow.Delete
                .Columns("U").Delete
            End With
            With .CurrentRegion
                .Font.Name = "calibri"
                .Font.Size = 10
                .VerticalAlignment = xlCenter
                .BorderAround Weight:=xlThin
                .Borders(xlInsideVertical).Weight = xlThin
                .Columns.AutoFit
            End With
            .Parent.Activate
        End With
    End With
End Sub

klin89

Au passage, ici https://forum.excel-pratique.com/excel/damande-d-aide-pour-tri-t73270.html#p419155 tu as comment faire avec une formule.

eric

Bonjour eriiic,

Merci, mais je n'arrive toujours pas à intégrer la formule , le lien que tu as donné est celui de cette page et non pas d'une autre ou il y est censé y avoir une indication pour m'aider.

Merci.

Bien cordialement

Florian

Bonjour,

le lien que tu as donné est celui de cette page

Non, sur le post de cette page que tu semblais ne pas avoir lu, n'ayant pas fait de retour.

Les formules et l'explication qui y sont sont plus qu'une indication je pense. Il suffit d'appliquer.

eric