Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

[VBA-Excel 2003] Incrémentation alphanumérique

17 réponses
Avatar
Péhemme
Bonjour(soir) à Tous,



J'ai un problème d'incrémentation alphabétique tordue.

J'ai une base de données qui s'alimente via des TextBox et Label placés sur
un UserForm.

Au moment de la saisie, un Label doit être rempli automatiquement en allant
chercher dans la BdD le n° précédent incrémenté de 1.



1°) Première partie à incrémenter (déjà tordue) : la série :

La difficulté est que le n° de départ (plus petit n°) étant AA-1001, l'incrémentation
se fait

a) numériquement de 1001 à 9999

b) puis alphabétiquement : de AA-9999 on passe à AB-1001, puis de AB-9999
on passe à AC-1001 (la limite théorique étant la série ZZ-1001 à ZZ-9999)

Si cela peut aider, on peut supprimer le tiret utilisé comme séparateur. Sa
présence a pour but d'obtenir une lecture plus facile du n° complet.



2°) Seconde partie : la lettre finale :

Elle doit s'incrémenter de K (plus petit caractère) à Z (le plus grand).
Cette incrémentation, bien que liée au n° de série, est indépendante de
celui-ci (une série quelconque peut, à titre d'exemple, ne posséder que 3
lettres finales distinctes (K, L ou M par exemple). Mais au minimum un seul
élément dans la série : K.

Le plus petit n° complet s'écrit donc AA-1001-K

Je n'ai pas encore traité ce dernier point, mais je me débrouillerai.



Ne sachant pas comment faire, j'ai solutionné le problème du n° de série :

a) en créant 4 colonnes dans ma BdD et 4 Label (dont 3 invisibles) sur
mon UserForm

b) en écrivant la macro suivante qui répond à mon problème mais qui me
semble « contorsionniste et bourrin ».



L'un d'entre vous sait-il si je peux, et dans la série « j'ai la plus
courte », incrémenter directement mes séries sans passer par la dichotomie
de son n°.

Merci d'avance de vos avis et commentaires.



La macro :

Private Sub UserForm_Initialize()

Dim x As Integer

Dim y As Integer

Dim z As Integer

Dim R As Long



If R = 65535 Then

MsgBox "Vous êtes à la fin de la page !"

GoTo Fin

Else

R = Sheets("Feuil1").Range("G65536").End(xlUp).Row

End If

'Une première ligne est déjà remplie à A, A, 1000 pour rentrer dans la
boucle

x = Range("G" & R).Value + 1

y = Asc(Range("Feuil1!F65536").End(xlUp).Value)

z = Asc(Range("Feuil1!E65536").End(xlUp).Value)



If x = 10000 Then

x = 1001

y = y + 1

If y = 91 Then

y = 65

z = z + 1

If z = 91 Then

GoTo Fin

End If

End If

End If



Label1.Visible = False

Label2.Visible = False

Label3.Visible = False



Label1 = Chr(z)

Label2 = Chr(y)

Label3 = x

Label4 = Label1 & Label2 & "-" & Label3

Exit Sub



Fin:

MsgBox "Vous êtes au maximum autorisé", vbCritical, "ATTENTION LIMITES
!"



End Sub



Bonne nuit

Michel

10 réponses

1 2
Avatar
isabelle
bonjour Michel,

voici comment passer de AA - 9999 à AB - 0001 et ainsi de suite ZY - 9999 à ZZ - 0001
en supposant que tu utilises xl 2007 et +

x = "AA - 9999"
n = Split(x, " - ")
aph = n(0)
no = n(1)
If CDbl(no) = 9999 Then aph1 = Columns(aph).Offset(0, 1).Column
MsgBox Application.Substitute(Cells(1, aph1).Address(0, 0), "1", "") & " - 0001"

pour le cas du "K" je n'ai pas compris de quoi il retourne, peut tu donner plus d'info ?

isabelle

Le 2010-08-13 18:49, Péhemme a écrit :
Bonjour(soir) à Tous,



J'ai un problème d'incrémentation alphabétique tordue.

J'ai une base de données qui s'alimente via des TextBox et Label placés
sur un UserForm.

Au moment de la saisie, un Label doit être rempli automatiquement en
allant chercher dans la BdD le n° précédent incrémenté de 1.



1°) Première partie à incrémenter (déjà tordue) : la série :

La difficulté est que le n° de départ (plus petit n°) étant AA-1001,
l'incrémentation se fait

a) numériquement de 1001 à 9999

b) puis alphabétiquement : de AA-9999 on passe à AB-1001, puis de
AB-9999 on passe à AC-1001 (la limite théorique étant la série ZZ-1001 à
ZZ-9999)

Si cela peut aider, on peut supprimer le tiret utilisé comme séparateur.
Sa présence a pour but d'obtenir une lecture plus facile du n° complet.
Avatar
isabelle
bonjour Michel,

voici comment passer de AA - 9999 à AB - 0001 et ainsi de suite ZY - 9999 à ZZ - 0001
en supposant que tu utilises xl 2007 et +

x = "AA - 9999"
n = Split(x, " - ")
aph = n(0)
no = n(1)
If CDbl(no) = 9999 Then
aph1 = Columns(aph).Offset(0, 1).Column
MsgBox Application.Substitute(Cells(1, aph1).Address(0, 0), "1", "") & " - 0001"
Else
MsgBox aph & " - " & CDbl(no) + 1
End If

pour le cas du "K" je n'ai pas compris de quoi il retourne, peut tu donner plus d'info ?

isabelle

Le 2010-08-13 18:49, Péhemme a écrit :
Bonjour(soir) à Tous,



J'ai un problème d'incrémentation alphabétique tordue.

J'ai une base de données qui s'alimente via des TextBox et Label placés
sur un UserForm.

Au moment de la saisie, un Label doit être rempli automatiquement en
allant chercher dans la BdD le n° précédent incrémenté de 1.



1°) Première partie à incrémenter (déjà tordue) : la série :

La difficulté est que le n° de départ (plus petit n°) étant AA-1001,
l'incrémentation se fait

a) numériquement de 1001 à 9999

b) puis alphabétiquement : de AA-9999 on passe à AB-1001, puis de
AB-9999 on passe à AC-1001 (la limite théorique étant la série ZZ-1001 à
ZZ-9999)

Si cela peut aider, on peut supprimer le tiret utilisé comme séparateur.
Sa présence a pour but d'obtenir une lecture plus facile du n° complet.
Avatar
isabelle
bonjour Michel,

voici comment passer de AA - 9999 à AB - 0001 et ainsi de suite ZY - 9999 à ZZ - 0001
en supposant que tu utilises xl 2007 et +

x = "AA - 9999"
n = Split(x, " - ")
aph = n(0)
no = n(1)
If CDbl(no) = 9999 Then
aph1 = Columns(aph).Offset(0, 1).Column
MsgBox Application.Substitute(Cells(1, aph1).Address(0, 0), "1", "") & " - 0001"
Else
MsgBox aph & " - " & Format(CDbl(no) + 1, "0000")
End Iff

pour le cas du "K" je n'ai pas compris de quoi il retourne, peut tu donner plus d'info ?

isabelle

Le 2010-08-13 18:49, Péhemme a écrit :
Bonjour(soir) à Tous,



J'ai un problème d'incrémentation alphabétique tordue.

J'ai une base de données qui s'alimente via des TextBox et Label placés
sur un UserForm.

Au moment de la saisie, un Label doit être rempli automatiquement en
allant chercher dans la BdD le n° précédent incrémenté de 1.



1°) Première partie à incrémenter (déjà tordue) : la série :

La difficulté est que le n° de départ (plus petit n°) étant AA-1001,
l'incrémentation se fait

a) numériquement de 1001 à 9999

b) puis alphabétiquement : de AA-9999 on passe à AB-1001, puis de
AB-9999 on passe à AC-1001 (la limite théorique étant la série ZZ-1001 à
ZZ-9999)

Si cela peut aider, on peut supprimer le tiret utilisé comme séparateur.
Sa présence a pour but d'obtenir une lecture plus facile du n° complet.
Avatar
isabelle
bonjour Michel,

voici comment passer de AA - 9999 à AB - 0001 et ainsi de suite ZY - 9999 à ZZ - 0001
en supposant que tu utilises xl 2007 et +

x = "AA - 9999"
n = Split(x, " - ")
aph = n(0)
no = n(1)

'If aph = "ZZ" And CDbl(no) = 9999 Then ??

If CDbl(no) = 9999 Then
aph1 = Columns(aph).Offset(0, 1).Column
MsgBox Application.Substitute(Cells(1, aph1).Address(0, 0), "1", "") & " - 0001"
Else
MsgBox aph & " - " & Format(CDbl(no) + 1, "0000")
End If

pour le cas du "K" je n'ai pas compris de quoi il retourne, peut tu donner plus d'info ?

isabelle



Le 2010-08-13 18:49, Péhemme a écrit :
Bonjour(soir) à Tous,



J'ai un problème d'incrémentation alphabétique tordue.

J'ai une base de données qui s'alimente via des TextBox et Label placés
sur un UserForm.

Au moment de la saisie, un Label doit être rempli automatiquement en
allant chercher dans la BdD le n° précédent incrémenté de 1.



1°) Première partie à incrémenter (déjà tordue) : la série :

La difficulté est que le n° de départ (plus petit n°) étant AA-1001,
l'incrémentation se fait

a) numériquement de 1001 à 9999

b) puis alphabétiquement : de AA-9999 on passe à AB-1001, puis de
AB-9999 on passe à AC-1001 (la limite théorique étant la série ZZ-1001 à
ZZ-9999)

Si cela peut aider, on peut supprimer le tiret utilisé comme séparateur.
Sa présence a pour but d'obtenir une lecture plus facile du n° complet.
Avatar
Maude Este
Bonsour®

"Péhemme" a écrit
1°) Première partie à incrémenter (déjà tordue) : la série :

La difficulté est que le n° de départ (plus petit n°) étant AA-1001,
l'incrémentation se fait

a) numériquement de 1001 à 9999

b) puis alphabétiquement : de AA-9999 on passe à AB-1001, puis de AB-9999 on
passe à AC-1001 (la limite théorique étant la série ZZ-1001 à ZZ-9999)




Sub test()
MsgBox "Ctrl-Pause pour interrompre ce test", vbExclamation, "Michel On
s'accroche !!!"
[A1] = Chr(65 + Rnd() * 26) & Chr(65 + Rnd() * 26) & "-" & Format(Rnd() * 10 ^
4, "0000")
For i = 1 To 20000
increment
DoEvents
Next
End Sub

Sub increment()
x = [A1]
alpha1 = Asc(UCase(Left(x, 1)))
alpha2 = Asc(UCase(Mid(x, 2, 1)))
nombre = CInt(Right(x, 4))
'-----incrementation numerique
nombre = nombre + 1
'-----incrementation 2éme lettre
If nombre > 9999 Then
alpha2 = alpha2 + 1
nombre = 0
End If
'-----incrementation 1ére lettre
If alpha2 > Asc("Z") Then
alpha2 = 65
alpha1 = alpha1 + 1
End If
'----- limite capacité
If alpha1 > Asc("Z") Then
MsgBox "limite capacité atteinte AA-9999"
Exit Sub
End If
'-----
[A1] = Chr(alpha1) & Chr(alpha2) & "-" & Format(nombre, "0000")
End Sub
Avatar
Péhemme
Bonjour Isabelle,

Merci beaucoup de ton aide, et ce d'autant plus que, sans les lire, j'ai cru
que tes messages étaient des répétitions et n'ai lu, dans un premier temps
que le premier.
J'ai donc pataté et suis arrivé à une macro se rapprochant de celle que tu
décris dans ton dernier message (et moi, pendant ce temps, je réinvente
l'eau tiède...).
Je suis revenu sur l'ouvrage et l'ai donc adaptée comme suit :
Sub Test_Isabelle()
Dim x
Dim n
Dim aph
Dim no
Dim aph1

x = Range("Feuil1!I65536").End(xlUp).Value
n = Split(x, " - ")
aph = n(0)
no = n(1)

If CDbl(no) = 9999 Then
aph1 = Columns(aph).Offset(0, 1).Column
x = Application.Substitute(Cells(1, aph1).Address(0, 0), "1", "") &
" - 1001"
Else
x = aph & " - " & Format(CDbl(no) + 1, "0000")
End If

Range("Feuil1!I65536").End(xlUp).Offset(1, 0) = x
End Sub


Et là, j'ai compris ce que venaient faire les "Columns(aph).Offset(0,
1).Column".
Tu incrémentes les lettres en te basant sur les noms des colonnes : t'es une
petite rusée... et moi bien triste, car, comme l'objet de mon message le
précisait, je suis en Excel 2003 et suis donc limité à la colonne IV,
j'atteins donc IV - 9999, puis => plantage.
Dommage, c'était court et malin. Cependant, y a-t-il une possibilité de
contourner cette "limitation" pour atteindre la limite maximum ZZ - 9999
au-delà de laquelle on ne peut pas aller (ZZ - 9999 + 1 => Exit sub) ?

Pour le cas des K ;-)) ne t'inquiète pas, je maitrise(rai)... Merci
beaucoup.
Juste pour être plus précis : c'est une lettre qui sert à distinguer les
éléments composant la série.
Ces lettre s'incrémentent de K à Z à l'intérieur de la série mais de façon
exogène (là je ne suis pas sûr d'être très clair).
Un élément => K ; le deuxième => L et ainsi de suite jusqu'au maximum de 16
soit la lettre Z, mais qui peut ne pas être atteinte.
Chaque série peut comporter un nombre différent d'éléments.
Elle peut ne comporter qu'un seul élément (minimum indispensable à
l'existence de la série) ; 2 éléments; voire 3... ou 16 (jamais plus).
Voili, voilou.

Merci encore
Michel


"isabelle" a écrit dans le message de
news:i455av$9l8$
bonjour Michel,

voici comment passer de AA - 9999 à AB - 0001 et ainsi de suite ZY - 9999
à ZZ - 0001
en supposant que tu utilises xl 2007 et +

x = "AA - 9999"
n = Split(x, " - ")
aph = n(0)
no = n(1)

'If aph = "ZZ" And CDbl(no) = 9999 Then ??

If CDbl(no) = 9999 Then
aph1 = Columns(aph).Offset(0, 1).Column
MsgBox Application.Substitute(Cells(1, aph1).Address(0, 0), "1", "") &
" - 0001"
Else
MsgBox aph & " - " & Format(CDbl(no) + 1, "0000")
End If

pour le cas du "K" je n'ai pas compris de quoi il retourne, peut tu donner
plus d'info ?

isabelle



Le 2010-08-13 18:49, Péhemme a écrit :
> Bonjour(soir) à Tous,
>
>
>
> J'ai un problème d'incrémentation alphabétique tordue.
>
> J'ai une base de données qui s'alimente via des TextBox et Label placés
> sur un UserForm.
>
> Au moment de la saisie, un Label doit être rempli automatiquement en
> allant chercher dans la BdD le n° précédent incrémenté de 1.
>
>
>
> 1°) Première partie à incrémenter (déjà tordue) : la série :
>
> La difficulté est que le n° de départ (plus petit n°) étant AA-1001,
> l'incrémentation se fait
>
> a) numériquement de 1001 à 9999
>
> b) puis alphabétiquement : de AA-9999 on passe à AB-1001, puis de
> AB-9999 on passe à AC-1001 (la limite théorique étant la série ZZ-1001 à
> ZZ-9999)
>
> Si cela peut aider, on peut supprimer le tiret utilisé comme séparateur.
> Sa présence a pour but d'obtenir une lecture plus facile du n° complet.
Avatar
Péhemme
Mon cher Maude (ou ma chère Gilbert) :-)),

Tu vois effectivement que je continue de "m'accrocher" et ce, sans changer
de sexe, mais pourquoi tu me fais un tirage aléatoire au lieu d'une
incrémentation "toute bête" (+1 à chaque fois, sauf aux sauts de pas
spécifiés) ? Tu veux vérifier si je suis ?... :-))

Merci de ton aide, je regarde si je peux adapter ta réponse.

Bien amicalement
Michel



"Maude Este" a écrit dans le message de
news:i45j3t$fts$
Bonsour®

"Péhemme" a écrit
1°) Première partie à incrémenter (déjà tordue) : la série :

La difficulté est que le n° de départ (plus petit n°) étant AA-1001,
l'incrémentation se fait

a) numériquement de 1001 à 9999

b) puis alphabétiquement : de AA-9999 on passe à AB-1001, puis de
AB-9999 on passe à AC-1001 (la limite théorique étant la série ZZ-1001 à
ZZ-9999)




Sub test()
MsgBox "Ctrl-Pause pour interrompre ce test", vbExclamation, "Michel On
s'accroche !!!"
[A1] = Chr(65 + Rnd() * 26) & Chr(65 + Rnd() * 26) & "-" & Format(Rnd() *
10 ^ 4, "0000")
For i = 1 To 20000
increment
DoEvents
Next
End Sub

Sub increment()
x = [A1]
alpha1 = Asc(UCase(Left(x, 1)))
alpha2 = Asc(UCase(Mid(x, 2, 1)))
nombre = CInt(Right(x, 4))
'-----incrementation numerique
nombre = nombre + 1
'-----incrementation 2éme lettre
If nombre > 9999 Then
alpha2 = alpha2 + 1
nombre = 0
End If
'-----incrementation 1ére lettre
If alpha2 > Asc("Z") Then
alpha2 = 65
alpha1 = alpha1 + 1
End If
'----- limite capacité
If alpha1 > Asc("Z") Then
MsgBox "limite capacité atteinte AA-9999"
Exit Sub
End If
'-----
[A1] = Chr(alpha1) & Chr(alpha2) & "-" & Format(nombre, "0000")
End Sub



Avatar
michdenis
Bonjour

2 Procédures :

Incrémenter toute la colonne A
La dernière lettre K a été omise, faute d'information adéquate.

Adapter le nom de la feuille si besoin...

Sub Incrémentation_Sur_Toute_La_Colonne()
Dim T As Variant, A As String, B As Long, R As String
Dim C As Range, DerLig As Long, ModCalcul As String

ModCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
With Worksheets("Feuil1")
'Valeur de la première cellule
.Range("A1") = "AA-1001"
'Dernière ligne de la feuille -1
DerLig = .Range("A:A").Rows.Count - 1
'Boucle sur chaque ligne de la feuille
For Each C In .Range("A1:A" & DerLig)
T = Split(C.Value, "-")
B = T(1)
If CLng(B) + 1 = 10000 Then
B = 1000
A = T(0)
If Asc(Right(A, 1)) = 90 Then
R = Chr(Asc(Left(A, 1)) + 1) & Chr(65) & "-1000"
Else
R = Left(A, 1) & Chr(Asc(Right(A, 1)) + 1) & "-1000"
End If
Else
R = T(0) & "-" & B + 1
End If
C.Offset(1) = R
Next
End With
Application.EnableEvents = True
Application.Calculation = ModCalcul
Application.ScreenUpdating = True
End Sub


Une cellule à la fois, la ligne 1 est présumée être l'étiquette de colonne

Sub Incrémentation_Une_Ligne_à_La_Fois()
Dim T As Variant, A As String, B As Long, R As String
Dim C As Range, DerLig As Long

With Worksheets("Feuil1")
With .Range("A" & .Range("A" & .Cells.Rows.Count).End(xlUp).Row)
If .Address = "$A$1" Then
If .Offset(1).Value = "" Then
.Offset(1).Value = "AA-1001"
Exit Sub
End If
Else
T = Split(.Value, "-")
B = T(1)
If CLng(B) + 1 = 10000 Then
B = 1000
A = T(0)
If Asc(Right(A, 1)) = 90 Then
R = Chr(Asc(Left(A, 1)) + 1) & Chr(65) & "-1000"
Else
R = Left(A, 1) & Chr(Asc(Right(A, 1)) + 1) & "-1000"
End If
Else
R = T(0) & "-" & B + 1
End If
.Offset(1).Value = R
End If
End With
End With
End Sub

--
MichD
--------------------------------------------


"Péhemme" a écrit dans le message de groupe de discussion : 4c667599$0$5428$
Mon cher Maude (ou ma chère Gilbert) :-)),

Tu vois effectivement que je continue de "m'accrocher" et ce, sans changer
de sexe, mais pourquoi tu me fais un tirage aléatoire au lieu d'une
incrémentation "toute bête" (+1 à chaque fois, sauf aux sauts de pas
spécifiés) ? Tu veux vérifier si je suis ?... :-))

Merci de ton aide, je regarde si je peux adapter ta réponse.

Bien amicalement
Michel



"Maude Este" a écrit dans le message de
news:i45j3t$fts$
Bonsour®

"Péhemme" a écrit
1°) Première partie à incrémenter (déjà tordue) : la série :

La difficulté est que le n° de départ (plus petit n°) étant AA-1001,
l'incrémentation se fait

a) numériquement de 1001 à 9999

b) puis alphabétiquement : de AA-9999 on passe à AB-1001, puis de
AB-9999 on passe à AC-1001 (la limite théorique étant la série ZZ-1001 à
ZZ-9999)




Sub test()
MsgBox "Ctrl-Pause pour interrompre ce test", vbExclamation, "Michel On
s'accroche !!!"
[A1] = Chr(65 + Rnd() * 26) & Chr(65 + Rnd() * 26) & "-" & Format(Rnd() *
10 ^ 4, "0000")
For i = 1 To 20000
increment
DoEvents
Next
End Sub

Sub increment()
x = [A1]
alpha1 = Asc(UCase(Left(x, 1)))
alpha2 = Asc(UCase(Mid(x, 2, 1)))
nombre = CInt(Right(x, 4))
'-----incrementation numerique
nombre = nombre + 1
'-----incrementation 2éme lettre
If nombre > 9999 Then
alpha2 = alpha2 + 1
nombre = 0
End If
'-----incrementation 1ére lettre
If alpha2 > Asc("Z") Then
alpha2 = 65
alpha1 = alpha1 + 1
End If
'----- limite capacité
If alpha1 > Asc("Z") Then
MsgBox "limite capacité atteinte AA-9999"
Exit Sub
End If
'-----
[A1] = Chr(alpha1) & Chr(alpha2) & "-" & Format(nombre, "0000")
End Sub



Avatar
Jacky
Bonjour Michel

Je te transmet une reponse de Denis sur Answers,
Debut copie
'------------------
(Comme la communication est impossible sur aioe.org
J'espère que quelqu'un aura la générosité de lui transmettre...

2 Procédures :

Incrémenter toute la colonne A
La dernière lettre K a été omise, faute d'information adéquate.

Adapter le nom de la feuille si besoin...

'-------------------------------------
Sub Incrémentation_Sur_Toute_La_Colonne()
Dim T As Variant, A As String, B As Long, R As String
Dim C As Range, DerLig As Long, ModCalcul As String

ModCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
With Worksheets("Feuil1")
'Valeur de la première cellule
.Range("A1") = "AA-1001"
'Dernière ligne de la feuille -1
DerLig = .Range("A:A").Rows.Count - 1
'Boucle sur chaque ligne de la feuille
For Each C In .Range("A1:A" & DerLig)
T = Split(C.Value, "-")
B = T(1)
If CLng(B) + 1 = 10000 Then
B = 1000
A = T(0)
If Asc(Right(A, 1)) = 90 Then
R = Chr(Asc(Left(A, 1)) + 1) & Chr(65) & "-1000"
Else
R = Left(A, 1) & Chr(Asc(Right(A, 1)) + 1) & "-1000"
End If
Else
R = T(0) & "-" & B + 1
End If
C.Offset(1) = R
Next
End With
Application.EnableEvents = True
Application.Calculation = ModCalcul
Application.ScreenUpdating = True
End Sub
'-------------------------------------

Une cellule à la fois, la ligne 1 est présumée être l'étiquette de colonne
'-------------------------------------
Sub Incrémentation_Une_Ligne_à_La_Fois()
Dim T As Variant, A As String, B As Long, R As String
Dim C As Range, DerLig As Long

With Worksheets("Feuil1")
With .Range("A" & .Range("A" & .Cells.Rows.Count).End(xlUp).Row)
If .Address = "$A$1" Then
If .Offset(1).Value = "" Then
.Offset(1).Value = "AA-1001"
Exit Sub
End If
Else
T = Split(.Value, "-")
B = T(1)
If CLng(B) + 1 = 10000 Then
B = 1000
A = T(0)
If Asc(Right(A, 1)) = 90 Then
R = Chr(Asc(Left(A, 1)) + 1) & Chr(65) & "-1000"
Else
R = Left(A, 1) & Chr(Asc(Right(A, 1)) + 1) & "-1000"
End If
Else
R = T(0) & "-" & B + 1
End If
.Offset(1).Value = R
End If
End With
End With
End Sub


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

MichD

'-------------Fin copie----------------


--
Salutations
JJ


"Péhemme" a écrit dans le message de news: 4c65cc28$0$10196$
Bonjour(soir) à Tous,



J'ai un problème d'incrémentation alphabétique tordue.

J'ai une base de données qui s'alimente via des TextBox et Label placés sur un UserForm.

Au moment de la saisie, un Label doit être rempli automatiquement en allant chercher dans la BdD le n°
précédent incrémenté de 1.



1°) Première partie à incrémenter (déjà tordue) : la série :

La difficulté est que le n° de départ (plus petit n°) étant AA-1001, l'incrémentation se fait

a) numériquement de 1001 à 9999

b) puis alphabétiquement : de AA-9999 on passe à AB-1001, puis de AB-9999 on passe à AC-1001 (la limite
théorique étant la série ZZ-1001 à ZZ-9999)

Si cela peut aider, on peut supprimer le tiret utilisé comme séparateur. Sa présence a pour but d'obtenir
une lecture plus facile du n° complet.



2°) Seconde partie : la lettre finale :

Elle doit s'incrémenter de K (plus petit caractère) à Z (le plus grand). Cette incrémentation, bien que liée
au n° de série, est indépendante de celui-ci (une série quelconque peut, à titre d'exemple, ne posséder que
3 lettres finales distinctes (K, L ou M par exemple). Mais au minimum un seul élément dans la série : K.

Le plus petit n° complet s'écrit donc AA-1001-K

Je n'ai pas encore traité ce dernier point, mais je me débrouillerai.



Ne sachant pas comment faire, j'ai solutionné le problème du n° de série :

a) en créant 4 colonnes dans ma BdD et 4 Label (dont 3 invisibles) sur mon UserForm

b) en écrivant la macro suivante qui répond à mon problème mais qui me semble « contorsionniste et
bourrin ».



L'un d'entre vous sait-il si je peux, et dans la série « j'ai la plus courte », incrémenter directement mes
séries sans passer par la dichotomie de son n°.

Merci d'avance de vos avis et commentaires.



La macro :

Private Sub UserForm_Initialize()

Dim x As Integer

Dim y As Integer

Dim z As Integer

Dim R As Long



If R = 65535 Then

MsgBox "Vous êtes à la fin de la page !"

GoTo Fin

Else

R = Sheets("Feuil1").Range("G65536").End(xlUp).Row

End If

'Une première ligne est déjà remplie à A, A, 1000 pour rentrer dans la boucle

x = Range("G" & R).Value + 1

y = Asc(Range("Feuil1!F65536").End(xlUp).Value)

z = Asc(Range("Feuil1!E65536").End(xlUp).Value)



If x = 10000 Then

x = 1001

y = y + 1

If y = 91 Then

y = 65

z = z + 1

If z = 91 Then

GoTo Fin

End If

End If

End If



Label1.Visible = False

Label2.Visible = False

Label3.Visible = False



Label1 = Chr(z)

Label2 = Chr(y)

Label3 = x

Label4 = Label1 & Label2 & "-" & Label3

Exit Sub



Fin:

MsgBox "Vous êtes au maximum autorisé", vbCritical, "ATTENTION LIMITES !"



End Sub



Bonne nuit

Michel

Avatar
Modeste
Bonsour®

"Péhemme" a écrit
mais pourquoi tu me fais un tirage aléatoire au lieu d'une incrémentation
"toute bête" (+1 à chaque fois, sauf aux sauts de pas spécifiés) ? Tu veux
vérifier si je suis ?... :-))



;o))) le tirage aléatoire ne concerne que la procédure de test

la macro incremente ne fait son action qu'une seule fois mais à chaque fois
quelle est exécutée

il serait alors trés simple de transformer cette macro en procédure et en lui
passant l'adresse en parametre

function Increment(Lacellule as range) as string
X=Lacellule
........
./.
.......
Increment= Chr(alpha1) & Chr(alpha2) & "-" & Format(nombre, "0000")
End Function

utilisation :
B2=Increment(A1)
1 2