Microsoft 365 Travail sur une chaine dans une boucle

[chris6999]

Bonjour

Petite question de traitement de chaine dans une boucle que je ne parviens pas à résoudre...

Je dois retraiter une chaine de données colonne I dont le résultat sera renseigné colonne B

Mes valeurs dans la colonne I sont de type AAAA.MM exemple 2024.05 pour mai 2024
Mon objectif est de récupérer en colonne B l'année AAAA et, à la suite, sans point de séparation, le N° de trimestre, puis le rang du mois dans le trimestre
EX 2024.05 devient 202422

J'essaye de trouver un code sans utiliser de formule car ça je saurais faire.

Est-ce que quelqu'un aurait une idée de la démarche à prendre?
J'ai essayé ceci mais cela ne fonctionne pas...

For Each c In ActiveSheet.Range(Cells(2, "B"), Cells(Derlig, "B"))
mois = Right(c.Offset(0, 7), 2).Value
If mois = "01" Then
c.Value = Left(c.Offset(0, 7), 4) & "11"
End If
Next c

Merci par avance pour votre aide
Je mets un fichier test en PJ
Bonne journée à tous

 

[TooFatBoy]

Bonjour,

Peut-être avec ceci :
Mois=val(Right(c.Offset(0, 7), 2))-1
Trimestre = int(mois/3)+1
RangMois=(mois mod 3)+1
Valeur=left(c.Offset(0, 7), 4) & Trimestre & RangMois

 

[Oneida]

Bonjour a tous,
Une autre facon de faire

 

[chris6999]

Bonjour,

Peut-être avec ceci :
Mois=val(Right(c.Offset(0, 7), 2))-1
Trimestre = int(mois/3)+1
RangMois=(mois mod 3)+1
Valeur=left(c.Offset(0, 7), 4) & Trimestre & RangMois

MERCI pour cette solution je vais tester

 

[chris6999]

Bonjour a tous,
Une autre facon de faire

Alors comment dire? je ne comprends pas trop comment cela fonctionne mais le moins qu'on puisse dire c'est que c'est d'une efficacité redoutable!
Merci encore

 

[AtTheOne]

Bonjour à toutes & à tous, bonjour @chris6999
Une solution par formule (avec ou sans fonction let)
À bientôt

 

[AtTheOne]

re

J'essaye de trouver un code sans utiliser de formule car ça je saurais faire.

Oups, Je n'avais pas bien lu !

 

[merinos-BernardEtang]

Bonjour @chris6999 ,


Ce genre de chose ne nécéssite pas de macro...

une simple substitution via une fonction LAMBDA (pour fair plus joli) suffit

 

[AtTheOne]

Re,

Ce genre de chose ne nécéssite pas de macro...

mais

J'essaye de trouver un code sans utiliser de formule car ça je saurais faire.

Une solution par formule (avec ou sans fonction let)

Du coup, j'ai repris la solution de @Oneida (c'est beaucoup plus facile quand le boulot est déjà fait )
en ajoutant des contrôles (renvoi d'une chaîne vide si non conformité) et en passant par un tableau VB pour accélérer au cas où il y aurait beaucoup de ligne à traiter.
J'ai commenté.

Le code:

'Version AtTheOne : Solution @Oneida avec contrôles et passage par un tableau VBA (si grand nombre de valeur à traiter
Sub TST()

     Const LgnDéb = 2, ColSce = 9, ColCbl = 2     'commence en ligne 2, colonne source "I", colonne cible "B"
     Dim Wsh As Worksheet                         'feuille source et cible
     Dim NbLgn As Long                            'nombre de lignes à traiter
     Dim Mois As Variant, An%, v$, r$             'en texte : année, valeur source, valeur retournée; En variant mois
     Dim Tablo, Tequi                             'tableau des valeurs à traiter / traitées
    
     Tequi = Array("", "11", "12", "13", "21", "22", "23", "31", "32", "33", "41", "42", "43") 'Chaînes équivalentes pour les mois (1er index=0)
    
     Set Wsh = ThisWorkbook.Worksheets(1)
    
     With Wsh
          NbLgn = .Cells(.Rows.Count, ColSce).End(xlUp).Row - LgnDéb + 1   'nb lignes à traiter
          Tablo = .Cells(LgnDéb, ColSce).Resize(NbLgn).Value2              'données source
          
          For i = 1 To UBound(Tablo, 1)                                    'boucle sur toutes les lignes à traiter
               v = Tablo(i, 1)                                             'valeur courante
               r = ""                                                      'valeur retournée si erreur
               If Len(v) = 7 Then                                          'longueur de chaîne attendue
                    An = Left(v, 4): Mois = Right(v, 2)                    'extraction Année, Mois
                    If IsNumeric(An) And IsNumeric(Mois) Then              'interprétables en nombre
                         Mois = CInt(Mois)                                 'convertion en entier
                         If Mois >= 1 And Mois <= 12 Then                  'correspond à un mois
                              r = An & Tequi(Mois)                         'valeur à retourner
                         End If
                    End If
               End If
               Tablo(i, 1) = r                                             'valeur retournée ("" si erreur)
          Next
          .Cells(LgnDéb, ColCbl).Resize(NbLgn).Value = Tablo               'affectation du résultat à la plage cible
     End With
End Sub

A bientôt

 

[patricktoulon]

bonjour à tous
perso je suis assez adepte du réutilisable
je préfère séparer

Function chainMonth(d)
    chainMonth = Val(Right(d, 2))
End Function

Function Trimestre(m)
    Trimestre = Int(m / 3) + 1
End Function

Function RangTrimestreMonth(m)
    RangTrimestreMonth = (m Mod 3) + 1
End Function

Function RefRangMonth(d)
    Dim y&, m&, T&
    If IsDate(d) Then
        y = Year(d)
        m = Month(d)
        T = Trimestre(m - 1)
    Else
        y = Left(d, 4)
        m = chainMonth(d) - 1
        T = Trimestre(m)
    End If
    RefRangMonth = y & T & RangTrimestreMonth(m)
End Function

Sub test()
    MsgBox RefRangMonth("2024.08")
End Sub

 

[AtTheOne]

Re

Function Trimestre(m) Trimestre = Int(m / 3) + 1 End Function

Pourquoi pas
Trimestre = Int((m -1)/ 3) + 1,
Et on a plus besoin de faire les - 1 après (si m = 3 on a bien trimestre =1)
À bientôt