Incrémentation automatique

"ThierryP" <t@toto.com> a écrit dans le message de news:
O6ougTe5KHA.1432@TK2MSFTNGP04.phx.gbl...

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

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" <t@toto.com> a écrit dans le message de news: O6ougTe5KHA.1432@TK2MSFTNGP04.phx.gbl...

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

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" <t@toto.com> a écrit dans le message de groupe de discussion :
O6ougTe5KHA.1432@TK2MSFTNGP04.phx.gbl...
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

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" <michdenis@hotmail.com> a écrit dans le message de groupe de discussion :
AB0BB6BD-ACF7-4901-A7C2-648C91BF9B3A@microsoft.com...
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" <t@toto.com> a écrit dans le message de groupe de discussion :
O6ougTe5KHA.1432@TK2MSFTNGP04.phx.gbl...
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

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

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" <t@toto.com> a écrit dans le message de news: O6ougTe5KHA.1432@TK2MSFTNGP04.phx.gbl...

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

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

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"<t@toto.com> a écrit dans le message de news:
O6ougTe5KHA.1432@TK2MSFTNGP04.phx.gbl...

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

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

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"<michdenis@hotmail.com> a écrit dans le message de groupe de discussion :
AB0BB6BD-ACF7-4901-A7C2-648C91BF9B3A@microsoft.com...
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