Générer des lignes avec données à partir d'un critère sur une cellule

Question

Je me permets de solliciter votre aide afin de résoudre un problème comme indiqué dans le titre. Je souhaite parcourir mon tableau ligne à ligne, vérifier si la première cellule ($Ax) contient au moins une virgule. Si oui, alors créer autant de lignes que de valeurs après la(les) virgule(s) en récupérant la chaîne de caractères précédant le "-" inclus, y coller la chaîne de caractère avant la virgule dans la nouvelle celle $Ax et recopier les mêmes données qui figurent dans les cellules suivantes. Je joins un fichier avec un onglet pour les données source et un autre pour le résultat attendu. Je vous remercie par avance pour votre précieuse aide. Bien à vous...

ThauThème · Accepted Answer

Bonjour Jahjah, bonjour le forum,

Essaie comme ça :

Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim ORA As Worksheet 'déclare la variable ORA (Onglet Resultat Attendu)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim NV As Byte 'déclare la variable NV (Nombre de Virgules)
Dim J As Byte 'déclare la variable J (incrément)
Dim LR As Integer 'déclare la variable LR (Ligne de Référence)
Dim PP As String 'déclare la variable PP (Première partie)

Set OS = Worksheets("source") 'définit l'onglet OS
Set ORA = Worksheets("resultat attendu") 'définit l'onglet ORA
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
ORA.Cells.ClearContents 'efface les anciennes donnés de l'onglet ORA
ORA.Cells(1, 1).Resize(1, UBound(TV, 2)).Value = Application.Index(TV, 1) 'récupère la première ligne du tableau des valeurs
For I = 2 To UBound(TV, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    NV = UBound(Split(TV(I, 1), ",")) 'définit le nombre de virgules NV de la donnée ligne I colonne 1
    If NV > 0 Then 'condition : si NV est supérieur à 0
        For J = 0 To NV 'boucle 2 : de 0 au nombre de virgules NV
            'définit la ligne de référence LR (ligne de la première cellule vide de la colonne A de l'onglet ORA)
            LR = ORA.Cells(Application.Rows.Count, "A").End(xlUp).Row + 1
            PP = Split(TV(I, 1), "-")(0) & "-" 'défnit la premièr partie de la donnée ligne I colonne 1 de TV (le texte avant le tiret plus le tiret)
            OS.Rows(I).Copy ORA.Cells(LR, 1) 'copie la ligne I de l'onglet OS dans la celljule ligne LR colonne 1 de l'onglet ORA
            'renvoie dans la cellule ligne LR colonne 1 soit le texte avant la première virgule, soit PP et le texte après la virgule NV
            ORA.Cells(LR, 1).Value = IIf(J = 0, Split(TV(I, 1), ",")(J), PP & Split(TV(I, 1), ",")(J))
        Next J 'prochaine virgule de la boucle 2
    Else 'sinon (si NV est égale à 0)
        'définit la ligne de référence LR (ligne de la première cellule vide de la colonne A de l'onglet ORA)
        LR = ORA.Cells(Application.Rows.Count, "A").End(xlUp).Row + 1
        OS.Rows(I).Copy ORA.Cells(LR, 1) 'copie la ligne I de l'onglet OS dans la celljule ligne LR colonne 1 de l'onglet ORA
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle 1
End Sub