XL 2019 Incrémentation

[sum01]

Bonjour à toutes et tous,

Je fais appel à votre aide avant de sombrer dans la folie car au départ je pensais le problème simple mais après une journée et les yeux qui se croise. J'essaie de trouve une solution pour incrémenter une liste de codes. Cette liste suit une logique. Chaque fois que j'arrive à 9, je recommence avec la lettre A ou à l'inverse, lorsque j'arrive à la lettre Z, je recommence avec le chiffre 0 et ainsi de suite. J'ai essayé de représenter la progression dans le petit fichier Excel ci-joint.
Je ne parviens pas à trouver une formule pour incrémenter cette progression. Une des piste que j'ai essayé de suivre est de remplacer les lettres par des chiffres en suivant la position dans l'alphabet mais là aussi je me suis perdu.

 

[Dranreb]

Bonsoir.
Si j'ai bien compris, il s'agit d'exprimer un entier en base 36, et de pouvoir retrouver un entier ainsi exprimé ?

Function Base36Num(ByVal Num As Long) As String
   Dim Chf As Byte
   Do: Chf = Num Mod 36
      Base36Num = Chr$(Chf + 48 - (Chf > 9) * 7) & Base36Num
      Num = Num \ 36: Loop Until Num = 0
   End Function
Function NuméroB36(ByVal B36 As String) As Long
   Dim Chf As Byte, P As Byte
   For P = 1 To Len(B36)
      Chf = Asc(Mid$(B36, P, 1)): If Chf > 57 Then Chf = Chf - 7
      NuméroB36 = 36 * NuméroB36 + Chf - 48: Next P
   End Function

Par exemple Base36Num(NuméroB36("3ZZ")+1) = "400"

 

[sum01]

Bonsoir.
Si j'ai bien compris, il s'agit d'exprimer un entier en base 36, et de pouvoir retrouver un entier ainsi exprimé ?

Function Base36Num(ByVal Num As Long) As String
   Dim Chf As Byte
   Do: Chf = Num Mod 36
      Base36Num = Chr$(Chf + 48 - (Chf > 9) * 7) & Base36Num
      Num = Num \ 36: Loop Until Num = 0
   End Function
Function NuméroB36(ByVal B36 As String) As Long
   Dim Chf As Byte, P As Byte
   For P = 1 To Len(B36)
      Chf = Asc(Mid$(B36, P, 1)): If Chf > 57 Then Chf = Chf - 7
      NuméroB36 = 36 * NuméroB36 + Chf - 48: Next P
   End Function

Par exemple Base36Num(NuméroB36("3ZZ")+1) = "400"

Bonjour Dranreb, Merci pour votre réponse. oui c'est bien cela après 3ZZ on passe à 400 et ainsi de suite. PAr contre, je n'ai pas réussi à faire fonctionner la macro. Erreur de compilation sur la première ligne du code ? Bon week-end

 

[Dranreb]

Pas d'erreur de compilation chez moi.

 

[Compte Supprimé 979]

Bonjour sum01, Dranreb

Je ne comprend pas, ça n'a plus rien à voir avec la demande initiale
Qui était d'incrémenter une série et pas un tirage aléatoire !?

@sum01 avez vous au moins essayé mon fichier, même si le codage n'est pas celui de Dranreb ?

XL 2019 - Incrémentation

Bonjour à toutes et tous, Je fais appel à votre aide avant de sombrer dans la folie car au départ je pensais le problème simple mais après une journée et les yeux qui se croise. J'essaie de trouve une solution pour incrémenter une liste de codes. Cette liste suit une logique. Chaque fois que...

www.excel-downloads.com

@+

 

[Dranreb]

Je ne comprend pas, ça n'a plus rien à voir avec la demande initiale

Ben si, sauf que je n'ai pas bien compris ce qu'il fallait faire exactement alors je me suis contenté de proposer deux fonctions certainement utiles pour le faire, puisqu'elles permettent de retrouver un nombre correspondant à un code existant, puis de reconvertir en un tel code ce nombre augmenté de 1.

 

[pierrejean]

Re
Un essai

 

[Dranreb]

Un essai avec la feuille d'origine

 

[sousou]

Bonjour à tous .
Pour le fun, si j'ai bien compris, il suffit de travailler en base 36 (chiffres+lettre)
Une fonction qui incrémente n'importe quel nombre dans n'importe quelle base
si j'ai pas fait d'erreur
J'avais oublié le fichier!!

 

[pierrejean]

Re
A partir des fonctions de Dranreb que je salue

Sub test()
Dim l As Long
Dim n As Long
l = 3
For n = NuméroB36("50A") To NuméroB36("6ZZ")
  Range("E" & l) = Base36Num(n)
  l = l + 1
Next
End Sub

 

[dysorthographie]

Bonjour,
je suis pas certains d'avoir tout compris!

Function AutoIncrément(ByVal T As String, Optional C As Integer = 0) As String
Dim TXT As String: TXT = "  " & T
If Trim(Mid(TXT, Len(TXT) - C, 1)) = "" Then Mid(TXT, Len(TXT) - C, 1) = "1": AutoIncrément = Trim(TXT): Exit Function
If Trim(Mid(TXT, Len(TXT) - C, 1)) = "9" Then Mid(TXT, Len(TXT) - C, 1) = "A": AutoIncrément = Trim(TXT): Exit Function
If Trim(Mid(TXT, Len(TXT) - C, 1)) = "Z" Then Mid(TXT, Len(TXT) - C, 1) = "0: AutoIncrément = AutoIncrément(Trim(TXT), ( C + 1)): Exit Function
Mid(TXT, Len(TXT) - C, 1) = Chr(Asc(Mid(TXT, Len(TXT) - C, 1)) + 1)
AutoIncrément = Trim(TXT)
End Function

Sub test()
Dim T As String
For i = 1 To 100
T = AutoIncrément(T)
Debug.Print T
Next
End Sub

 

[sum01]

Bonjour sum01, Dranreb

Je ne comprend pas, ça n'a plus rien à voir avec la demande initiale
Qui était d'incrémenter une série et pas un tirage aléatoire !?

@sum01 avez vous au moins essayé mon fichier, même si le codage n'est pas celui de Dranreb ?

XL 2019 - Incrémentation

Bonjour à toutes et tous, Je fais appel à votre aide avant de sombrer dans la folie car au départ je pensais le problème simple mais après une journée et les yeux qui se croise. J'essaie de trouve une solution pour incrémenter une liste de codes. Cette liste suit une logique. Chaque fois que...

www.excel-downloads.com

@+

Bonjour Bruno, je vous confirme que j'ai essayé et adopté votre solution où l'on retrouve les cas plus complexes. Votre code est parfaitement aligné à la demande initiale. Par ailleurs, je l'avoue, je pense ne pas avoir été très clair dans la formulation de ma demande car à la base j'ai eu de la peine à comprendre comment la structure de la table de codification avait été pensée à son origine. Chaque solution proposée amène quelque chose de super intéressant à décortiquer et est riche en enseignement même si cela dévie de l'idée de base. Dans tous les cas, le débat soulevé et la richesse des solutions proposées me rend admiratif