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

JBARBE

XLDnaute Barbatruc

• 11 Novembre 2019

• #2

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

bonne journée !

 

Dernière édition: 11 Novembre 2019

Vote positif 0 Vote négatif

JBARBE

XLDnaute Barbatruc

• 11 Novembre 2019

• #3

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

@+

 

Vote positif 0 Vote négatif

T

thespeedy20

XLDnaute Occasionnel

• 11 Novembre 2019

• #4

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

 

Vote positif 0 Vote négatif

mapomme

XLDnaute Barbatruc

Supporter XLD

• 11 Novembre 2019

• #5

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: 11 Novembre 2019

Vote positif 0 Vote négatif

JBARBE

XLDnaute Barbatruc

• 11 Novembre 2019

• #6

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

 

Pièces jointes

• ClasseurA.xls

  55 KB · Affichages: 8

Vote positif 0 Vote négatif

T

thespeedy20

XLDnaute Occasionnel

• 11 Novembre 2019

• #7

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

 

Vote positif 0 Vote négatif

JBARBE

XLDnaute Barbatruc

• 11 Novembre 2019

• #8

thespeedy20 à dit:

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

Cliquez pour agrandir...

Re,
Un exemple SVP !
@+

 

Vote positif 0 Vote négatif

T

thespeedy20

XLDnaute Occasionnel

• 11 Novembre 2019

• #9

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

 

Vote positif 0 Vote négatif

mapomme

XLDnaute Barbatruc

Supporter XLD

• 11 Novembre 2019

• #10

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: 11 Novembre 2019

Vote positif 0 Vote négatif

T

thespeedy20

XLDnaute Occasionnel

• 11 Novembre 2019

• #11

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

 

Vote positif 0 Vote négatif

mapomme

XLDnaute Barbatruc

Supporter XLD

• 11 Novembre 2019

• #12

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.

 

Vote positif 0 Vote négatif

T

thespeedy20

XLDnaute Occasionnel

• 11 Novembre 2019

• #13

re,

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

 

Vote positif 0 Vote négatif

T

thespeedy20

XLDnaute Occasionnel

• 11 Novembre 2019

• #14

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

 

Vote positif 0 Vote négatif

mapomme

XLDnaute Barbatruc

Supporter XLD

• 11 Novembre 2019

• #15

Re @thespeedy20,

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

 

Vote positif 0 Vote négatif