XL 2019 Incrémentation

sum01 · 20 Mars 2021

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 · 20 Mars 2021

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

VB:

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 · 21 Mars 2021

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

VB:

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 · 21 Mars 2021

Pas d'erreur de compilation chez moi.

Compte Supprimé 979 · 21 Mars 2021

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 · 21 Mars 2021

BrunoM45 à dit:
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 · 21 Mars 2021

Re
Un essai

Dranreb · 21 Mars 2021

Un essai avec la feuille d'origine

sousou · 21 Mars 2021

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 · 21 Mars 2021

Re
A partir des fonctions de Dranreb que je salue

VB:

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 · 21 Mars 2021

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

VB:

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 · 21 Mars 2021

BrunoM45 à dit:
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

XL 2019 Incrémentation

sum01

XLDnaute Occasionnel

Pièces jointes

Dranreb

XLDnaute Barbatruc

sum01

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

Pièces jointes

Compte Supprimé 979

Guest

XL 2019 - Incrémentation

Dranreb

XLDnaute Barbatruc

pierrejean

XLDnaute Barbatruc

Pièces jointes

Dranreb

XLDnaute Barbatruc

Pièces jointes

sousou

XLDnaute Barbatruc

Pièces jointes

pierrejean

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

sum01

XLDnaute Occasionnel

XL 2019 - Incrémentation

Discussions similaires