[RESOLU] Classement doublons

[Annette]

Bonjour le forum,

Je n'arrive pas à extraire des doublons et à effectuer un classement par ordre d'apparition de ces mêmes doublons, tout ceci en une fois par formule ... .
Quelqu'un aurait-il une suggestion à me proposer par formule ou même macro ?

Merci pour votre aide.

Cordialement

 

[job75]

Re : Classement doublons

Bonjour Annette,

En C3, formule matricielle à valider par Ctrl+Maj+Entrée :

=INDEX(B:B;EQUIV(MAX(NB.SI(B$1:B$1000;B$1:B$1000));NB.SI(B$1:B$1000;B$1:B$1000);0))

En C4, formule matricielle à valider par Ctrl+Maj+Entrée et tirer vers le bas :

=SIERREUR(PETITE.VALEUR(SI((NB.SI(B$1:B$1000;B$1:B$1000)>1)*(NB.SI(C$3:C3;B$1:B$1000)=0);B$1:B$1000);1);"")

A+

 

[Nairolf]

Re : Classement doublons

Salut Anette et job75, salut le forum,

Je vous propose une réponse version vba dans le fichier joint (code largement perfectible).

 

[Annette]

Re : Classement doublons

Bonjour Nairolf, job75 , le forum,

Nairolf,
Macro opérationnelle qui répond à ma demande et plus car je n'avais pas émis l'hypothèse de plusieurs chiffres revenant par exemple 3 fois (ou plus) chacun.

job75,
Formules opérationnelles sauf si plusieurs chiffres reviennent 3 fois (ex: 3 fois 41 et 3 fois 13), une possibilité de palier à cette éventualité ?

Merci pour vos suggestions.

Cordialement

 

[job75]

Re : Classement doublons

Re, salut Nairolf,

job75,
Formules opérationnelles sauf si plusieurs chiffres reviennent 3 fois (ex: 3 fois 41 et 3 fois 13), une possibilité de palier à cette éventualité ?

Par formule cela est a priori bien compliqué.

De toute façon sur un grand tableau les formules prendront beaucoup de temps de calcul (à cause des NB.SI).

Cette solution VBA est très rapide car elle utilise le Dictionary et des tableaux VBA :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Address <> "$C$3" Then Exit Sub 'adresse à adapter
Dim t, t1(), d As Object, i&, j&
Cancel = True
t = Range("B1", Range("B" & Rows.Count).End(xlUp)(2)) 'matrice, plus rapide
ReDim t1(1 To UBound(t), 1 To 2)
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(t)
  If t(i, 1) <> "" Then
    If d.exists(t(i, 1)) Then
      j = d(t(i, 1))
      If t1(j, 1) = "" Then t1(j, 1) = t(i, 1)
      t1(j, 2) = t1(j, 2) + 1
    Else
      d(t(i, 1)) = i
    End If
  End If
Next
'---restitution---
Application.ScreenUpdating = False
Target.Resize(Rows.Count - Target.Row + 1).ClearContents 'RAZ
Target(1, 2).EntireColumn.Insert 'colonne auxiliaire
With Target.Resize(UBound(t), 2)
  .Value = t1
  '---classement pour trouver les maxima---
  .Sort Target(1, 2), xlDescending, , Target, xlAscending, Header:=xlNo
  For i = 2 To UBound(t)
    If .Cells(i, 2) <> .Cells(1, 2) Then
      ThisWorkbook.Names.Add "lig", i + Target.Row - 1 'nom défini pour la MFC
      Exit For
    End If
  Next
  '---classement du reste---
  .Offset(i - 1).Sort Target, xlAscending, Header:=xlNo
End With
Target(1, 2).EntireColumn.Delete
End Sub

Il y a 2 tris, l'un pour trouver les maxima, l'autre pour classer le reste.

Fichier joint, voyez aussi la MFC sur la colonne C.

A+

 

[Annette]

Re : Classement doublons

job75,

Merci pour cette nouvelle solution .
Tant pis pour les formules, les solutions par VBA me conviennent.
Merci à vous deux pour vos solutions et merci au forum .

Cordialement

 

[job75]

Re : Classement doublons

Re Annette,

Notez qu'au post #5 j'ai ajouté :

- End(xlUp)(2) au cas où la dernière cellule en colonne B est B1 car t doit avoir au moins 2 éléments

- If t(i, 1) <> "" Then pour éliminer les cellules vides.

Bonne fin de soirée.

 

[Annette]

Re : [RESOLU] Classement doublons

Job75,

Merci pour ce retour .

Bonne fin de soirée également.

Cordialement