Ajout d'un numéro en fonction d'un classement avec doublons vba

thespeedy20

XLDnaute Occasionnel
Bonjour,

J'ai un classement qui s'effectue automatiquement sur ma feuille et j'aimerais lui ajouter un numéro également automatique....
ex : aaa
aaa
bbb
ccc
ccc

Cela donnerait :

1 aaa
1 aaa
2 bbb
3 ccc
3 ccc
4 ddd


Merci d'avance pour votre aide

Oli
 

Pièces jointes

  • Annexe 11 - Test.xlsm
    27 KB · Affichages: 18

JBARBE

XLDnaute Barbatruc
Bonjour à tous,
Je n'ai pu obtenir ton fichier !
Peut-être ceci !
VB:
Option Explicit

Sub test()
Dim i As Long
For i = 1 To 10
Cells(i, 1) = i & Cells(i, 1)
Next i
End Sub
macro.jpg

bonne journée !
 
Dernière édition:

thespeedy20

XLDnaute Occasionnel
RE,

en B18, je note olivier, par defaut, la cellule A18 est égale à 1

en B19 , je note Bernard
en B20 je note Alain
en B21, je note Olivier

Donc le classement devient :
Col A Col B
1 Alain
2 Bernard
3 Olivier
3 Olivier

et je peux encore ajouter des noms... il trie et réattribue des numéros au nouveau classement

Oli
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re,

Essayez ce code à mettre dans le module de la feuille "Feuil1":
VB:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
   If Not Application.Intersect(Target, Range("B:B")) Is Nothing Then Call Trier: Call numeroter
End Sub

Sub Trier()
   Dim LastRow As Long
   LastRow = ActiveSheet.Range("B18").End(xlDown).Row
   Range("B18:C" & LastRow).Sort Key1:=Range("B18"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
      MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
End Sub

Sub numeroter()
   Dim LastRow As Long, i As Long
   LastRow = Range("B18").End(xlDown).Row
   Range("a18:a" & LastRow).FormulaR1C1 = "=SUM(R[-1]C,RC[1]<>R[-1]C[1])"
   Range("a18:a" & LastRow) = Range("a18:b" & LastRow).Value
End Sub
 

Pièces jointes

  • thespeedy20- trier ordonner- v1.xlsm
    26.5 KB · Affichages: 9
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 904
Membres
101 834
dernier inscrit
Jeremy06510