Résolu 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
 

Fichiers joints

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:

JBARBE

XLDnaute Barbatruc
Re,
Un petit rajout à la macro !
VB:
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

XLDnaute Occasionnel
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

XLDnaute Barbatruc
Supporter XLD
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)
 
Dernière édition:

thespeedy20

XLDnaute Occasionnel
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....
 

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
 

Fichiers joints

Dernière édition:

thespeedy20

XLDnaute Occasionnel
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

XLDnaute Barbatruc
Supporter XLD
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

XLDnaute Occasionnel
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....
 

thespeedy20

XLDnaute Occasionnel
re mapomme,

Quand j'efface toutes les données, pour partir d'une feuille vierge, il numérote la colonne jusqu'au bout(la dernière ligne 1048576) ....avec une erreur définie par l'application ou par l'objet....:-(
 

thespeedy20

XLDnaute Occasionnel
Bonjour mapomme,

c'est impeccable, cela fonctionne très bien... je te remercie vivement pour ton aide.....

Oli
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas