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

[thespeedy20]

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

 

[JBARBE]

Bonjour à tous,
Je n'ai pu obtenir ton fichier !
Peut-être ceci !

Option Explicit

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

bonne journée !

 

[JBARBE]

Re,
Un petit rajout à la macro !

Option Explicit

Sub test()
Dim i As Long
Application.ScreenUpdating = False
For i = 1 To 10
Cells(i, 1) = i & Cells(i, 1)
Next i
Application.ScreenUpdating = True
End Sub

@+

 

[thespeedy20]

Bonjour JBARBE,

Le numéro doit se trouver en colonne A et si il y a plusieurs noms identiques(colonneB), avoir le même numero...

Exemple :
A B

1 aaa
1 aaa
2 ccc
3 fff
4 ggg
4 ggg

 

[mapomme]

Bonjour à tous,

Si la colonne B est triée (ce que je pense avoir compris), alors :

• En A18 mettre la formule : =SI(B18=B17;SOMME(A17);SOMME(A17;1))
• Copier/tirer la formule vers le bas

Ou bien formule plus simple : =SOMME(A17;B18<>B17)

 

[JBARBE]

Bonjour mapomme,
Peut-être ceci en VBA !
Bonne journée !

 

[thespeedy20]

re,

je dois aussi pouvoir ajouter des noms dans la liste, le tri se fait automatiquement et la numérotation aussi avec doublon si plusieurs fois....

 

[JBARBE]

re,

je dois aussi pouvoir ajouter des noms dans la liste, le tri se fait automatiquement et la numérotation aussi avec doublon si plusieurs fois....

Re,
Un exemple SVP !
@+

 

[thespeedy20]

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]

Re,

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

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

 

[thespeedy20]

re mapomme,

Merci pour ta proposition,

Quand j'efface les données, il met une erreur, pour ce faire la taille des cellules fusionnées doit être identique et renvois sur la macro de tri... et les numéros ne s'efface pas....pour le reste pas de problèmes...

Oli

 

[mapomme]

RE,

Avec des cellules fusionnées dans un tableau "type base de données", vous ne pouvez avoir que des problèmes (pour les tris, filtres, ... etc)
Je l'ai dit, je le dis et le dirai encore.

 

[thespeedy20]

re,

le document n'est pas de moi....je vais le modifier pour ne plus avoir de problèmes...merci

 

[thespeedy20]

re,

J'ai enlevé les cellules fusionnées et je veux enlever les données sauf les deux premières A18,B18 ET A19,B19 qui génère une erreur....

 

[mapomme]

Re @thespeedy20,

Pouvez-vous renvoyer un fichier, svp (celui sur le quel vous avez tenté d'enlever les cellules fusionnées)