Crée une référence automatique sous VBA

Bonjour Forum,

Comme il est déjà indiqué sur le sujet, j'aimerais créé une référence automatique du genre "JJMMAA_ABCD_EFGH_IJKLM_001", dont sur ce seul les deux extrémités de ces caractères sont dynamiques et les autres restes statiques.

ce référence se génère automatiquement une fois une condition est remplie et se sont exportés sur une base de données d'une autre feuille. Je tiens à préciser que les numéros _001 reprends le début si on change de jour c'est à dire une fois les premiers caractère JJMMAA change

Cordialement

Bonjour Alexis et bienvenu, bonjour le forum,

Tu ne daignes même pas nous fournir le contexte ou un exemple... De***dez-vous, je pose ma question !...

En pièce jointe une proposition avec le code ci-dessous :

Private Sub CommandButton1_Click()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (Jour)
Dim M As Byte 'déclare la variable M (Mois)
Dim A As Integer 'déclare la variable A (Année)
Dim D As String 'déclare la variable D (Début)
Dim V As Integer 'déclare la variable V (Valeur)
Dim VM As Integer 'déclare la variable VM (Valeur Maximum)
Dim F As String 'déclare la variable F (Fin)
Dim NC As String 'déclare la variable NC (Nouveau Code)

Set O = Worksheets("Feuil1") 'définit l'onglet O
DL = O.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet O
J = Day(Date) 'définit le jour J
M = Month(Date) 'définit le mois M
A = Year(Date) 'définit l'année A
D = Format(J, "00") & Format(M, "00") & Right(A, 2) 'définit le début D
For I = 1 To DL 'boucle sur toutes les ligne I du tableau des valeurs TV
    If Left(O.Cells(I, "A"), 6) = D Then 'condition : si les 6 premiers caractères de la cellule ligne I colonne A sont égaux à D
        V = Right(O.Cells(I, 1), 3) 'définit la valeur V (les 3 derniers caractères
        If V > VM Then VM = V 'si V est supérieure à VM, VM devient V
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
If V = 0 Then F = "001" Else F = Format(VM + 1, "000") 'si V=0 F est égale à "001", sinon F est égake à VM+1 formaté
NC = D & "_ABCD_EFGH_IJKLM_" & F 'définit le nouveau code NC
O.Cells(DL + 1, "A").Value = NC 'renvoie le nouveau code NC dans la cellule ligne DL+1 colonne A de l'onglet O
End Sub

Désolée d'avoir tout bêtement s'incruster sur vos échanges mes j'ai aussi la même soucis et j'ai pu consulter la solution proposée par ThauThème que je trouve très pratique sur ce cas mais par contre pour moi je veux que ça soit l'avant dernière caractère qui est dynamique.

En prenant votre exemple je veux comme résultat

""ABCDE_EFGHI_" 001 "_JKLMN".

Je vous remercie déjà pour vos retours.

Cordialement

Voici en image ci dessus là où j'en suis maintenant

bonjour,

les 2 options dans la meme feuille

Const CodeFixe = "_ABCD_EFGH_IJKLM_"

Const CodeFixe1 = "ABCDE_EFGHI_"
Const CodeFixe2 = "_JKLMN"

Sub AlternativeMarcellin()
     Dim s, i1, i2, s1, iProchain, arr
     s = Format(Date, "yymmdd") & CodeFixe    'code pour aujourd'hui, sauf le numéro
     i1 = Len(s): i2 = i1 + 3     'longueur du code et de la partie sans le numéro
     With Sheets("feuil1")
          .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp)).Name = "MesCodes"     'plage avec les codes utilisés
          s1 = "IF((LEN(MesCodes)=" & i2 & ")*(left(mescodes," & i1 & ")=""" & s & """)*(ISNUMBER(--RIGHT(MesCodes,3))),--RIGHT(MesCodes,3),0)"     'longueur correct & 1ier partie okay & 2ieme partie numerique
          arr = Evaluate(s1)     'array dans laquelle tous les codes d'aujourd'hui montrent le valeur des 3 derniers chiffres et le rest est 0
          iProchain = Application.Max(arr) + 1
          Range("A" & Rows.Count).End(xlUp).Offset(1).Value = s & Format(iProchain, "000")
     End With
End Sub

Sub AlternativeMotro()
     Dim s, i1, i2, s1, iProchain, arr
     i1 = Len(CodeFixe1): i2 = Len(CodeFixe2)     'longueur du code et de la partie sans le numéro
     With Sheets("feuil1")
          .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp)).Name = "MesCodes"     'plage avec les codes utilisés
          s1 = "IF((LEft(MesCodes," & i1 & ")=""" & CodeFixe1 & """)*(right(mescodes," & i2 & ")=""" & CodeFixe2 & """)*(ISNUMBER(--mid(MesCodes," & i1 + 1 & ",3))),--mid(MesCodes," & i1 + 1 & ",3),0)"  'longueur correct & 1ier partie okay & 2ieme partie numerique
          arr = Evaluate(s1)     'array dans laquelle tous les codes d'aujourd'hui montrent le valeur des 3 derniers chiffres et le rest est 0
          iProchain = Application.Max(arr) + 1
          Range("A" & Rows.Count).End(xlUp).Offset(1).Value = CodeFixe1 & Format(iProchain, "000") & CodeFixe2
     End With
End Sub

Merci beaucoup 🙏🙏🙏 BsAlv ça marche très bien, mais en passant si ça ne te dérange pas tu peux m'expliquer d'avantage ce passage que j'ai mis entre crochets en surligneur orange de l'image ci-jointe svp.

Un grand merci

re,

c'est une méthode de créer en VBA une formule en anglais avec des variables. La formule française qu'on peut utiliser dans la cellule B2 et que regarde vers A2 est ici en dessous + une macro qui sert à mieux comprendre ce système.

=SI((GAUCHE(A2;12)="ABCDE_EFGHI_")*(DROITE(A2;6)="_JKLMN")*(ESTNUM(--STXT(A2;13;3)));--STXT(A2;13;3);0)

et puis dans un code VBA qui l'utilise dans la colonne B

Sub Explication()
     i1 = Len(CodeFixe1): i2 = Len(CodeFixe2)     'longueur du code et de la partie sans le numéro
     s0 = Range("mesCodes").Cells(1).Address(0, 0)     'l'addres de la premiere cellule de MesCodes, c'est a dire A2
     s1 = "IF((LEft(MesCodes," & i1 & ")=""" & CodeFixe1 & """)*(right(mescodes," & i2 & ")=""" & CodeFixe2 & """)*(ISNUMBER(--mid(MesCodes," & i1 + 1 & ",3))),--mid(MesCodes," & i1 + 1 & ",3),0)"  'ce string dans AlternativeMotro
     s2 = Replace(s1, "mescodes", s0, , , 1)     'remplacer "MesCodes" par l'adresse de la première cellule de MesCodes
     MsgBox s2 & vbLf & "=SI((GAUCHE(A2;12)=""ABCDE_EFGHI_"")*(DROITE(A2;6)=""_JKLMN"")*(ESTNUM(--STXT(A2;13;3)));--STXT(A2;13;3);0)", vbInformation, "Formule en anglais et francais"     'les 2 versions, anglais et français
     Range("MesCodes").Offset(, 1).Value = "=" & s2     'copier la formule anglaise dans la colonne B
End Sub

Et alors vous voyez des 0 pour des Références qui ne correspondent pas a "MOTRO" ou le valeur des 3 chiffres au milieu.

Là je te suis très bien, mais en suivant cette logique, j'essaie de combiner les deux alternatives initiales, cad je veux avoir la date en début de la chaîne et mettre le numéro"001" en avant dernier comme dans le cas "Môtro" mais je tombe tjrs sur une dysfonctionnement de mes codes. Tu peux encore m'aider sur ce cas stp

Cordialement

c'était trop difficile pour expliquer, donc une manière plus élegante.