Rang sans doublons

[Hoareau]

Bonjour

Soit une liste de chiffre avec doublons, je voudrais connaitre le rang de chaque chiffre, en ne comptant chaque chiffre qu'une fois.

merci

 

[skoobi]

Re : Rang sans doublons

Bonsoir,

avec ce que j'ai compris......:

Sub doub()
Dim liste As New Collection
liste.Add [A1].Value, CStr([A1].Value)
Range("b1") = "ici"
For Each cellule In Range([A2], [A65536].End(xlUp))
    On Error Resume Next
    liste.Add cellule.Value, CStr(cellule.Value)
    If Err.Number = 0 Then
        cellule.Offset(0, 1).Value = "ici"
    Else: cellule.Offset(0, 1).Value = ""
    End If
    On Error GoTo 0
Next
End Sub

En supposant que la liste de chiffres se trouve en colonne A, "ici" est écrit à coté du chiffre trouvé la première fois.

 

[Hoareau]

Re : Rang sans doublons

Merci pour la macro, mais mes données sont sur plusieurs colonnes, jusqu'à 10
Le principe est bon mais je n'ais pas le rang que j'ai mis à côté des ici dans l'exemple ci dessous.
1 ici 1
1
2 ici 2
3 ici 3
4 ici 4
4
10 ici 6
11 ici 7
6 ici 5
15 ici 9
14 ici 8

 

[BOISGONTIER]

Re : Rang sans doublons

Bonjour,

Formule:

=SOMME(--(A2<SI(EQUIV(Notes;Notes;0)=LIGNE(INDIRECT("1:"&LIGNES(Notes)));Notes;0)))+1
Valider avec Maj+Ctrl+Entrée

En VBA:

Function RangSansDoublons(n, champ)
  Application.Volatile
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In champ
    If Not mondico.Exists(c.Value) Then mondico.Add c.Value, c.Value
  Next c
  t = 0
  For Each c In mondico.items
    If c > n Then
      t = t + 1
    End If
  Next c
  RangSansDoublons = t + 1
End Function

JB
Formation Excel VBA JB

 

[Hoareau]

Re : Rang sans doublons

merci
pour la marro et le fichier exemple


N'y a t il pas possibilité de pouvoir avec la fonction vba de choisir
soit du plus grand au plus petit
soit du plus petit au plus grand

merci

 

[BOISGONTIER]

Re : Rang sans doublons

Bonjour,

Function RangSansDoublons(n, champ, Optional ordre)
  Application.Volatile
  If IsMissing(ordre) Then ordre = 0
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In champ
    If Not mondico.Exists(c.Value) Then mondico.Add c.Value, c.Value
  Next c
  t = 0
  For Each c In mondico.items
   Select Case ordre
    Case 0
      If c > n Then t = t + 1
    Case 1
      If c < n Then t = t + 1
   End Select
  Next c
  RangSansDoublons = t + 1
End Function

JB

 

[Hoareau]

Re : Rang sans doublons

Impeccable

merci