Incrémentation automatique

Le
ThierryP
Bonjour le forum !

J'ai besoin de créer des numéros de série incrémentés de 1 en 1 à partir de la
valeur entrée dans une cellule (ce numéro n'est pas numérique, il est de la
forme aa-xxxxxxx). En rassemblant quelques neurones fatigués, voir ci-dessous ce
que j'ai pondu. La question est : il y a surement un moyen de faire plus
rapidement et plus élégamment Appel aux gourous !!!

Merci d'avance à tou(te)s

-
Sub Numero()
Application.EnableEvents = False
debut = ActiveCell.Value
nombre = InputBox("Quantité")
For i = 1 To nombre - 1
unite = Val(Right(debut, 1))
If unite <> 9 Then
unite = unite + 1
debut = Left(debut, Len(debut) - 1) & unite
Else
unite = 0
dizaine = Val(Right(Left(debut, Len(debut) - 1), 1))
If dizaine <> 9 Then
dizaine = dizaine + 1
debut = Left(debut, Len(debut) - 2) & dizaine & unite
Else
dizaine = 0
centaine = Val(Right(Left(debut, Len(debut) - 2), 1))
If centaine <> 9 Then
centaine = centaine + 1
debut = Left(debut, Len(debut) - 3) & centaine & dizaine & unite
Else
centaine = 0
millier = Val(Right(Left(debut, Len(debut) - 3), 1))
If millier <> 9 Then
millier = millier + 1
debut = Left(debut, Len(debut) - 4) & millier & centaine &
dizaine & unite
End If
End If
End If
End If
ActiveCell.Offset(i, 0).Value = debut
Next
Application.EnableEvents = True
End Sub

-


@+ thierryp
--
Passer pour un idiot aux yeux d'un imbécile est une volupté de fin gourmet - G.
Courteline
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses Page 1 / 2
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Caetera
Le #21638361
"ThierryP"
J'ai besoin de créer des numéros de série incrémentés de 1 en 1 à partir de la
valeur entrée dans une cellule (ce numéro n'est pas numérique, il est de la
forme aa-xxxxxxx). En rassemblant quelques neurones fatigués, voir ci-dessous
ce que j'ai pondu. La question est : il y a surement un moyen de faire plus
rapidement et plus élégamment...... Appel aux gourous !!!



*****************************

Avec ta solution...problèmes possibles :
Essaye donc avec la variable "nombre" = 30000
......

Une approche :

Sub azerty()
nombre = InputBox("Quantité")
Application.ScreenUpdating = False
x1 = Left(ActiveCell, InStr(ActiveCell, "-"))
x2 = Mid(ActiveCell, InStr(ActiveCell, "-") + 1, 9 ^ 9)
décal = 1
For i = 1 To nombre
x2 = x2 + 1
ActiveCell.Offset(décal, 0).Value = x1 & x2
décal = décal + 1
Next
End Sub

Etc
Jacky
Le #21639051
Bonjour,

Une piste avec comme minimum d'entrée de la cellule de départ "aa-"
'---------------
Sub Numero()
'Application.EnableEvents = False
If ActiveCell = "" Or Len(ActiveCell) < 3 Then Exit Sub
ActiveCell.Value = Left(ActiveCell, 3) & Format(Val(Mid(ActiveCell, 4, 9 ^ 9)) + (Abs(Mid(ActiveCell, 4, 9 ^
9) = "") * 1), "0000000")
nombre = InputBox("Quantité")
If Not IsNumeric(nombre) Then Exit Sub
debut = Left(ActiveCell, 3) & Format(Val(Mid(ActiveCell, 4, 9 ^ 9)) + (Abs(Mid(ActiveCell, 4, 9 ^ 9) = "") *
1), "0000000")
For i = 1 To nombre
ActiveCell.Offset(i, 0).Value = Left(debut, 3) & Format(Mid(debut, 4, 9 ^ 9) + i, "0000000")
Next
Application.EnableEvents = True
End Sub
'--------------------

--
Salutations
JJ


"ThierryP"
Bonjour le forum !

J'ai besoin de créer des numéros de série incrémentés de 1 en 1 à partir de la valeur entrée dans une
cellule (ce numéro n'est pas numérique, il est de la forme aa-xxxxxxx). En rassemblant quelques neurones
fatigués, voir ci-dessous ce que j'ai pondu. La question est : il y a surement un moyen de faire plus
rapidement et plus élégamment...... Appel aux gourous !!!

Merci d'avance à tou(te)s

----------------------
Sub Numero()
Application.EnableEvents = False
debut = ActiveCell.Value
nombre = InputBox("Quantité")
For i = 1 To nombre - 1
unite = Val(Right(debut, 1))
If unite <> 9 Then
unite = unite + 1
debut = Left(debut, Len(debut) - 1) & unite
Else
unite = 0
dizaine = Val(Right(Left(debut, Len(debut) - 1), 1))
If dizaine <> 9 Then
dizaine = dizaine + 1
debut = Left(debut, Len(debut) - 2) & dizaine & unite
Else
dizaine = 0
centaine = Val(Right(Left(debut, Len(debut) - 2), 1))
If centaine <> 9 Then
centaine = centaine + 1
debut = Left(debut, Len(debut) - 3) & centaine & dizaine & unite
Else
centaine = 0
millier = Val(Right(Left(debut, Len(debut) - 3), 1))
If millier <> 9 Then
millier = millier + 1
debut = Left(debut, Len(debut) - 4) & millier & centaine & dizaine & unite
End If
End If
End If
End If
ActiveCell.Offset(i, 0).Value = debut
Next
Application.EnableEvents = True
End Sub

----------------


@+ thierryp
-----------------
Passer pour un idiot aux yeux d'un imbécile est une volupté de fin gourmet - G. Courteline
michdenis
Le #21639041
Bonjour,

Une alternative :
A ) Nom de la feuille à adapter
B ) J'ai déterminé que la première cellule était A1, à adapter
C ) En A1 se trouve la chaîne de caractères
première partie : Alphanumérique
Séparateur : "-"
Deuxième partie : chiffre x
D) Recopie la section alphanumérique en incrémentant de 1
la section numérique.

'-----------------------------------
Sub test()
Dim Rg As Range,Rad as String, Coef As Long
With Worksheets("Feuil1")
Set Rg = .Range("A1:A3000")
rad = Left(.Range("A1"), InStr(1, .Range("A1"), "-", vbTextCompare))
coef = CLng(Replace(.Range("A1"), rad, ""))
End With
With Rg
.Offset(1).Formula = "=""" & rad & """&" & coef & "+" & "Row(A1)"
.Offset(1).Value = .Value
End With
End Sub
'-----------------------------------



"ThierryP"
Bonjour le forum !

J'ai besoin de créer des numéros de série incrémentés de 1 en 1 à partir de la
valeur entrée dans une cellule (ce numéro n'est pas numérique, il est de la
forme aa-xxxxxxx). En rassemblant quelques neurones fatigués, voir ci-dessous ce
que j'ai pondu. La question est : il y a surement un moyen de faire plus
rapidement et plus élégamment...... Appel aux gourous !!!

Merci d'avance à tou(te)s

----------------------
Sub Numero()
Application.EnableEvents = False
debut = ActiveCell.Value
nombre = InputBox("Quantité")
For i = 1 To nombre - 1
unite = Val(Right(debut, 1))
If unite <> 9 Then
unite = unite + 1
debut = Left(debut, Len(debut) - 1) & unite
Else
unite = 0
dizaine = Val(Right(Left(debut, Len(debut) - 1), 1))
If dizaine <> 9 Then
dizaine = dizaine + 1
debut = Left(debut, Len(debut) - 2) & dizaine & unite
Else
dizaine = 0
centaine = Val(Right(Left(debut, Len(debut) - 2), 1))
If centaine <> 9 Then
centaine = centaine + 1
debut = Left(debut, Len(debut) - 3) & centaine & dizaine & unite
Else
centaine = 0
millier = Val(Right(Left(debut, Len(debut) - 3), 1))
If millier <> 9 Then
millier = millier + 1
debut = Left(debut, Len(debut) - 4) & millier & centaine &
dizaine & unite
End If
End If
End If
End If
ActiveCell.Offset(i, 0).Value = debut
Next
Application.EnableEvents = True
End Sub

----------------


@+ thierryp
-----------------
Passer pour un idiot aux yeux d'un imbécile est une volupté de fin gourmet - G.
Courteline
michdenis
Le #21639261
Peut-être préfères-tu cette syntaxe :
'-----------------------------
Sub test()
Dim Rad As String, Coef As Long
With Worksheets("Feuil1").Range("A1:A3000")
Rad = Left(.Item(1, 1), InStr(1, .Item(1, 1), "-", vbTextCompare))
Coef = CLng(Replace(.Item(1, 1), Rad, ""))
.Formula = "=""" & Rad & """&" & Coef - 1 & "+" & "Row(A1)"
.Value = .Value
End With
End Sub
'-----------------------------


"michdenis"
Bonjour,

Une alternative :
A ) Nom de la feuille à adapter
B ) J'ai déterminé que la première cellule était A1, à adapter
C ) En A1 se trouve la chaîne de caractères
première partie : Alphanumérique
Séparateur : "-"
Deuxième partie : chiffre x
D) Recopie la section alphanumérique en incrémentant de 1
la section numérique.

'-----------------------------------
Sub test()
Dim Rg As Range,Rad as String, Coef As Long
With Worksheets("Feuil1")
Set Rg = .Range("A1:A3000")
rad = Left(.Range("A1"), InStr(1, .Range("A1"), "-", vbTextCompare))
coef = CLng(Replace(.Range("A1"), rad, ""))
End With
With Rg
.Offset(1).Formula = "=""" & rad & """&" & coef & "+" & "Row(A1)"
.Offset(1).Value = .Value
End With
End Sub
'-----------------------------------



"ThierryP"
Bonjour le forum !

J'ai besoin de créer des numéros de série incrémentés de 1 en 1 à partir de la
valeur entrée dans une cellule (ce numéro n'est pas numérique, il est de la
forme aa-xxxxxxx). En rassemblant quelques neurones fatigués, voir ci-dessous ce
que j'ai pondu. La question est : il y a surement un moyen de faire plus
rapidement et plus élégamment...... Appel aux gourous !!!

Merci d'avance à tou(te)s

----------------------
Sub Numero()
Application.EnableEvents = False
debut = ActiveCell.Value
nombre = InputBox("Quantité")
For i = 1 To nombre - 1
unite = Val(Right(debut, 1))
If unite <> 9 Then
unite = unite + 1
debut = Left(debut, Len(debut) - 1) & unite
Else
unite = 0
dizaine = Val(Right(Left(debut, Len(debut) - 1), 1))
If dizaine <> 9 Then
dizaine = dizaine + 1
debut = Left(debut, Len(debut) - 2) & dizaine & unite
Else
dizaine = 0
centaine = Val(Right(Left(debut, Len(debut) - 2), 1))
If centaine <> 9 Then
centaine = centaine + 1
debut = Left(debut, Len(debut) - 3) & centaine & dizaine & unite
Else
centaine = 0
millier = Val(Right(Left(debut, Len(debut) - 3), 1))
If millier <> 9 Then
millier = millier + 1
debut = Left(debut, Len(debut) - 4) & millier & centaine &
dizaine & unite
End If
End If
End If
End If
ActiveCell.Offset(i, 0).Value = debut
Next
Application.EnableEvents = True
End Sub

----------------


@+ thierryp
-----------------
Passer pour un idiot aux yeux d'un imbécile est une volupté de fin gourmet - G.
Courteline
Modeste
Le #21639501
Bonsour®
J'ai besoin de créer des numéros de série incrémentés de 1 en 1 à partir
de la valeur entrée dans une cellule (ce numéro n'est pas numérique, il
est de la forme aa-xxxxxxx).



en C1 le N° d'origine (valeur entrée dans une cellule )
en A1 la formule :
="aa-"&TEXTE($C$1+LIGNE();"0000000")

recopier la formule vers le bas autant que nécessaire
Tatanka
Le #21639951
Bonjour Thierry,

Ceci te convient-il ?

Sub Essai()
Set pr = ActiveCell
debut = Split(pr.Value, "-")
nombre = InputBox("Quantité")
Application.ScreenUpdating = False
For i = 1 To nombre - 1
pr.Offset(i, 0).Value = "'" & debut(0) & "-" & debut(1) + i
Next i
Application.ScreenUpdating = True
End Sub

Serge



"ThierryP"
Bonjour le forum !

J'ai besoin de créer des numéros de série incrémentés de 1 en 1 à partir de la valeur entrée dans une cellule (ce numéro n'est pas
numérique, il est de la forme aa-xxxxxxx). En rassemblant quelques neurones fatigués, voir ci-dessous ce que j'ai pondu. La
question est : il y a surement un moyen de faire plus rapidement et plus élégamment...... Appel aux gourous !!!

Merci d'avance à tou(te)s

----------------------
Sub Numero()
Application.EnableEvents = False
debut = ActiveCell.Value
nombre = InputBox("Quantité")
For i = 1 To nombre - 1
unite = Val(Right(debut, 1))
If unite <> 9 Then
unite = unite + 1
debut = Left(debut, Len(debut) - 1) & unite
Else
unite = 0
dizaine = Val(Right(Left(debut, Len(debut) - 1), 1))
If dizaine <> 9 Then
dizaine = dizaine + 1
debut = Left(debut, Len(debut) - 2) & dizaine & unite
Else
dizaine = 0
centaine = Val(Right(Left(debut, Len(debut) - 2), 1))
If centaine <> 9 Then
centaine = centaine + 1
debut = Left(debut, Len(debut) - 3) & centaine & dizaine & unite
Else
centaine = 0
millier = Val(Right(Left(debut, Len(debut) - 3), 1))
If millier <> 9 Then
millier = millier + 1
debut = Left(debut, Len(debut) - 4) & millier & centaine & dizaine & unite
End If
End If
End If
End If
ActiveCell.Offset(i, 0).Value = debut
Next
Application.EnableEvents = True
End Sub

----------------


@+ thierryp
-----------------
Passer pour un idiot aux yeux d'un imbécile est une volupté de fin gourmet - G. Courteline
ThierryP
Le #21641641
Eh bien !! Je ne pensais pas que mon petit souci allait intéresser autant de
monde :-))))) Et que du beau monde en plus !

Merci à tous ! Je vais étudier le tout à tête reposée.

PS pour Caetera : en fait, je triche un peu...Seul mon cas particulier me
préoccupait (ces nombres respecteront toujours un même nombre de chiffres et la
même présentation, je connais ceux qui doivent changer dans un avenir
raisonnable), donc j'ai écrit la macro en fonction de ça...


@+ thierryp
-----------------
Passer pour un idiot aux yeux d'un imbécile est une volupté de fin gourmet - G.
Courteline
ThierryP
Le #21641631
Désolé, j'ai posté sur le mauvais message...

J'aurais encore appris quelque chose aujourd'hui !!

Merci !

Le 27/04/2010 11:07, Caetera a écrit :
"ThierryP"
J'ai besoin de créer des numéros de série incrémentés de 1 en 1 à partir de la
valeur entrée dans une cellule (ce numéro n'est pas numérique, il est de la
forme aa-xxxxxxx). En rassemblant quelques neurones fatigués, voir ci-dessous
ce que j'ai pondu. La question est : il y a surement un moyen de faire plus
rapidement et plus élégamment...... Appel aux gourous !!!



*****************************

Avec ta solution...problèmes possibles :
Essaye donc avec la variable "nombre" = 30000
......

Une approche :

Sub azerty()
nombre = InputBox("Quantité")
Application.ScreenUpdating = False
x1 = Left(ActiveCell, InStr(ActiveCell, "-"))
x2 = Mid(ActiveCell, InStr(ActiveCell, "-") + 1, 9 ^ 9)
décal = 1
For i = 1 To nombre
x2 = x2 + 1
ActiveCell.Offset(décal, 0).Value = x1& x2
décal = décal + 1
Next
End Sub

Etc





--


@+ thierryp
-----------------
Passer pour un idiot aux yeux d'un imbécile est une volupté de fin gourmet - G.
Courteline
ThierryP
Le #21641621
Une autre piste à explorer !!

Merci :-)

Le 27/04/2010 12:32, Jacky a écrit :
Bonjour,

Une piste avec comme minimum d'entrée de la cellule de départ "aa-"
'---------------
Sub Numero()
'Application.EnableEvents = False
If ActiveCell = "" Or Len(ActiveCell)< 3 Then Exit Sub
ActiveCell.Value = Left(ActiveCell, 3)& Format(Val(Mid(ActiveCell, 4, 9 ^ 9)) + (Abs(Mid(ActiveCell, 4, 9 ^
9) = "") * 1), "0000000")
nombre = InputBox("Quantité")
If Not IsNumeric(nombre) Then Exit Sub
debut = Left(ActiveCell, 3)& Format(Val(Mid(ActiveCell, 4, 9 ^ 9)) + (Abs(Mid(ActiveCell, 4, 9 ^ 9) = "") *
1), "0000000")
For i = 1 To nombre
ActiveCell.Offset(i, 0).Value = Left(debut, 3)& Format(Mid(debut, 4, 9 ^ 9) + i, "0000000")
Next
Application.EnableEvents = True
End Sub
'--------------------




--


@+ thierryp
-----------------
Passer pour un idiot aux yeux d'un imbécile est une volupté de fin gourmet - G.
Courteline
ThierryP
Le #21641601
Et en plus j'ai le choix !!

Encore merci

Le 27/04/2010 13:31, michdenis a écrit :
Peut-être préfères-tu cette syntaxe :
'-----------------------------
Sub test()
Dim Rad As String, Coef As Long
With Worksheets("Feuil1").Range("A1:A3000")
Rad = Left(.Item(1, 1), InStr(1, .Item(1, 1), "-", vbTextCompare))
Coef = CLng(Replace(.Item(1, 1), Rad, ""))
.Formula = "="""& Rad& """&"& Coef - 1& "+"& "Row(A1)"
.Value = .Value
End With
End Sub
'-----------------------------


"michdenis"
Bonjour,

Une alternative :
A ) Nom de la feuille à adapter
B ) J'ai déterminé que la première cellule était A1, à adapter
C ) En A1 se trouve la chaîne de caractères
première partie : Alphanumérique
Séparateur : "-"
Deuxième partie : chiffre x
D) Recopie la section alphanumérique en incrémentant de 1
la section numérique.

'-----------------------------------
Sub test()
Dim Rg As Range,Rad as String, Coef As Long
With Worksheets("Feuil1")
Set Rg = .Range("A1:A3000")
rad = Left(.Range("A1"), InStr(1, .Range("A1"), "-", vbTextCompare))
coef = CLng(Replace(.Range("A1"), rad, ""))
End With
With Rg
.Offset(1).Formula = "="""& rad& """&"& coef& "+"& "Row(A1)"
.Offset(1).Value = .Value
End With
End Sub
'-----------------------------------



--


@+ thierryp
-----------------
Passer pour un idiot aux yeux d'un imbécile est une volupté de fin gourmet - G.
Courteline
Publicité
Poster une réponse
Anonyme