Extraction doublons

Bonjour à tous et toutes, j'aimerais en vba si possible extraire que les doublons colonne "A" sur une autre feuille, compter le nombres d'occurrence et les classer par ordre ( de celui qui apparait le plus à celui qui apparait le moins)

En quelques sorte faire un classement du plus mauvais au moins mauvais.

Merci de m'aider svp.

Bonjour le forum,bruno9442

Pour extraire les doublons,il y a une macro complémentaire réalisée par Mdf

Merci, j'y ais pensé mais cela m'oblige a transporter un xla sur d'autres pc.

Je préfèrerais avoir tout sur mon classeur.

J'ai tester avec l'enregistreur de macro mais je me retrouve toujours avec un double et je ne comprend pas pourquoi j'ai toujours un doublon.

merci de voir ce qui ne va pas dans mon code et aussi de voir pour copier le résultat sur une autres feuilles Svp

Bonsoir,

Essaye avec cela

Salut le forum

Marc02, désolé ton code ne fonctionne pas sous Excel 2003.

RemoveDuplicates n'existe que depuis Excel 2007.

Un code à lancer depuis la feuille extraction

Sub SansDoublons()
Dim Cel As Range
Dim MonDico As Object

Set MonDico = CreateObject("Scripting.Dictionary")

With Sheets("saisie")
    For Each Cel In .Range("A5:A" & .Cells(Rows.Count, "A").End(xlUp).Row)
       MonDico(Cel.Value) = Cel.Value
    Next Cel
End With

[A5].Resize(MonDico.Count, 1) = Application.Transpose(MonDico.keys)

End Sub

Mytå

Bonjour, merci a vous de ce pencher sur mon problème.

Effectivement la macro de Marc 02 ne marche pas sur excel 2003.

Merci Mytâ mais je ne souhaite pas extraire sans doublons mais plutôt l'opération inverse c'est à dire extraire que les doublons.

Merci.

Amicalement bruno9442.

Bonjour,

En partant du code de Mytå :

Sub NbDoublons()
Dim Cel As Range, Plg As Range
Dim MonDico As Object, MonDico2 As Object

Set MonDico = CreateObject("Scripting.Dictionary")
Set MonDico2 = CreateObject("Scripting.Dictionary")

With Sheets("saisie")
    Set Plg = .Range("A5:A" & .Cells(Rows.Count, "A").End(xlUp).Row)
    For Each Cel In Plg
        If Not MonDico.Exists(Cel.Value) Then
            MonDico(Cel.Value) = Cel.Value
        Else
            MonDico2(Cel.Value) = Application.CountIf(Plg, Cel.Value)
        End If
    Next Cel
End With
With Sheets("extraction")
    .Columns("A:B").ClearContents
    .[A5].Resize(MonDico2.Count, 1) = Application.Transpose(MonDico2.Keys)
    .[B5].Resize(MonDico2.Count, 1) = Application.Transpose(MonDico2.Items)
    .Range("A5:B" & .Cells(Rows.Count, "A").End(xlUp).Row).Sort Key1:=.Range("B5"), Order1:=xlDescending, Header:=xlNo
End With
End Sub

Bonne journée

Merci cousinhub cela marche bien .

Je fais amende honorable en ce qui concerne mon orthographe (se pencher)

Bonjour ,

Je vois que cela est résolu ,

Bon malgré tout comme j'ai planché et que c'est pas tout à fait la même technique , je te poste

Bonjour,

Merci, Mytå pour la correction

suis a mes debut en VBA j'étudie sur ce site

Marc

Merci a vous tous.

Et bravo pour ce site, avec lui j'apprend beaucoup de choses.