[VBA-Excel 2003] Incrémentation alphanumérique
Péhemme
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
isabelle
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
isabelle
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 :
isabelle
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 :
isabelle
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 :
Maude Este
"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
Péhemme
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" <i...@v.org> a écrit dans le message de
news:i455av$9l8$1...@speranza.aioe.org...
Péhemme
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" <nom...@live.fr> a écrit dans le message de
news:i45j3t$fts$1...@speranza.aioe.org...
Jacky
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" <x...@xx.xx> a écrit dans le message de news: 4c65cc28$0$10196$ba4a...@reader.news.orange.fr...
Modeste
"Péhemme" <x...@xx.xx> 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)
Maude Este
"Péhemme" <x...@xx.xx> 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)
Péhemme
Merci à toi de jouer les transmetteurs.
Il faudra bien qu'un jour j'installe ce fameux bridge...
Tu peux dire à Denis :
"Ta macro (au cas par cas) fonctionne parfaitement bien.
Je l'ai juste adaptée à mes besoins.
Je suis effectivement un peu faiblard dans l'utilisation des fonctions de
chaîne (s'il n'y avait que là...).
J'ai là matière à les travailler.
Ah, au fait, Merci !
:-))
Michel"
Merci à toi aussi Jacky
Michel
"Jacky" <Dup...@marcel.fr> a écrit dans le message de
news:4c667ec4$0$5400$ba4a...@reader.news.orange.fr...
Jacky
>Tu peux dire à Denis :
Donc, pas besoin de lui transmettre ;o))
--
Bon we
Jacky
"Péhemme" <x...@xx.xx> a écrit dans le message de news: 4c669cf7$0$5390$ba4a...@reader.news.orange.fr...
Modeste
Dup...@marcel.fr> a écrit
> S'il ne peut pas émettre sur aioe.org, il peut néanmoins lire les news.
> Donc, pas besoin de lui transmettre ;o))
en désespoir de cause
c'est toujours possible de là :
http://groups.google.fr/group/microsoft.public.fr.excel/topics?lnk=srg&hl=fr
Péhemme
Tu sais que ce n'est pas si mal ta proposition ?
:-))
Mille mercis, cela fonctionne parfaitement bien
Amitiés
Michel
"Maude Este" <nom...@live.fr> a écrit dans le message de
news:i460o9$gqt$1...@speranza.aioe.org...
Péhemme
;-)
Michel
"Jacky" <Dup...@marcel.fr> a écrit dans le message de
news:4c66bd3f$0$5431$ba4a...@reader.news.orange.fr...
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()
Une cellule à la fois, la ligne 1 est présumée être l'étiquette de colonne
Sub Incrémentation_Une_Ligne_à_La_Fois()
--
MichD
--------------------------------------------
"Péhemme" <x...@xx.xx> a écrit dans le message de groupe de discussion : 4c667599$0$5428$ba4a...@reader.news.orange.fr...
Péhemme
J'ai adapté ta proposition (une ligne à la fois) et cela fonctionne à
merveille.
Bien amicalement
Michel
"michdenis" <mich...@hotmail.com> a écrit dans le message de
news:i49dlu$g9i$1...@speranza.aioe.org...