none
Créer un tableau avec plusieurs lignes à partir d'une cellule Excel 2013 contenant plusieurs lignes RRS feed

  • Question

  • Bonjour, Je voudrais créer un tableau Excel avec plusieurs lignes à partir d'une ligne où les cellules contiennent plusieurs lignes. Existe-t'il une macro pour résoudre ce problème ?

    Exemple :

    Champs 5 Champs 6 Champs 7 Champs 8 Champs 9 Champs 10 Champs 11 Champs 12 Champs 13 Champs 14 Champs 15
    UNITE 1 DOMAINE 1 Agence 1 Service 1  

    AGENT UN

    AGENT DEUX

    AGENT TROIS

    AGENT QUATRE

    AGENT CINQ

    UNITE 1

    UNITE 1

    UNITE 1

    UNITE 1

    UNITE 1

    DOMAINE 1 DOMAINE 1 DOMAINE 1 DOMAINE 1 DOMAINE 1

    Agence 1

    Agence 1

    Agence 1

    Agence 1

    gence 1

    SERVICE UN SERVICE DEUX SERVICE DEUX SERVICE DEUX SERVICE DEUX 5

    Le tableau ci-dessus devient le tableau ci-dessous : 

    Champs 5 Champs 6 Champs 7 Champs 8 Champs 9 Champs 10 Champs 11 Champs 12 Champs 13 Champs 14 Champs 15
    UNITE 1 DOMAINE 1 Agence 1 Service 1   AGENT UN UNITE 1 DOMAINE 1 Agence 1 SERVICE UN 5
    UNITE 1 DOMAINE 1 Agence 1 Service 1   AGENT DEUX UNITE 1 DOMAINE 1 Agence 1 SERVICE DEUX 5
    UNITE 1 DOMAINE 1 Agence 1 Service 1   AGENT TROIS UNITE 1 DOMAINE 1 Agence 1 SERVICE DEUX 5
    UNITE 1 DOMAINE 1 Agence 1 Service 1   AGENT QUATRE UNITE 1 DOMAINE 1 Agence 1 SERVICE DEUX 5
    UNITE 1 DOMAINE 1 Agence 1 Service 1   AGENT CINQ UNITE 1 DOMAINE 1 Agence 1 SERVICE DEUX 5

    Le nombre de ligne par cellule du tableau initial peut être différent. Par contre, si le champs 10 contient 3 lignes, les champs 11, 12, 13 et 14 en contiendront aussi 3. Les lignes correspondent : La première ligne des champs 10 à 14 est à convertir en 1 ligne. La difficulté supplémentaire est qu'il faut recopier les autres champs dans chaque ligne du tableau d'arrivée.

    Merci d'avance pour l'aide que vous pourrez m'apportez :-)

    Si besoin, je peux fournir un fichier pour tester. Me dire où je l'envoi.

    Salutations

    Nono

    dimanche 28 janvier 2018 22:49

Réponses

  • Bonsoir,

    je crois qu'avec cette version de la macro on s'approche de votre besoin:

    - On ne teste plus si la colonne T est vide, mais on fait ce test sur la colonne B

    - On teste ensuite la valeur de la cellule ("B" & ligneencours"), et si elle est égale à "d" (test en minuscule), on effectue un traitement spécifique (uniquement copier/coller la ligne)

    Sub splitcells()
        
        'copie entête Feuille Split dans feuille Auto (à créer manuellement)
        Sheets("Split").Select
        Range("A1:AM1").Select
        Selection.Copy
        Sheets("Auto").Select
        Range("A1").Select
        ActiveSheet.Paste
        
           
        'création d'une variable par colonne à traiter
        Dim TableauT() As String
        Dim TableauU() As String
        Dim TableauV() As String
        Dim TableauW() As String
        Dim TableauX() As String
        
        'variable de boucle
        Dim i As Integer
        
        'Variables de ligne de travail
        Dim lignedispo As Integer
        Dim lignetraitee As Integer
    
    'Initialisation des lignes au numéro 2 (1er = entête)
    lignedispo = 2
    ligneencours = 2
    
    'Tant que la cellule de la colonne B n'est pas vide, on continue le traitement
    Do While Not (IsEmpty(Sheets("Split").Range("B" & ligneencours)))
    
        ' Si la Colonne "B" contient une autre valeur que "d" (comparaison forcée en minuscule), on traite les données multiples
        If Not (LCase(Sheets("Split").Range("B" & ligneencours).Value) = "d") Then
            
            'Créations de tableaux pour les colonnes à traiter
            TableauT = Split(Sheets("Split").Range("T" & ligneencours).Value, vbLf)
            TableauU = Split(Sheets("Split").Range("U" & ligneencours).Value, vbLf)
            TableauV = Split(Sheets("Split").Range("V" & ligneencours).Value, vbLf)
            TableauW = Split(Sheets("Split").Range("W" & ligneencours).Value, vbLf)
            TableauX = Split(Sheets("Split").Range("X" & ligneencours).Value, vbLf)
            
            
            
            'boucle sur le tableau de la colonne T
            For i = 0 To UBound(TableauT)
            
                'Copie de la ligne complète du tableau source
                Sheets("Auto").Range("A" & lignedispo & ":AM" & lignedispo).Value = Sheets("Split").Range("A" & ligneencours & ":AM" & ligneencours).Value
                
                'Copie de la ligne souhaitée à la place de la cellule "multi lignes"
                
                Sheets("Auto").Range("T" & lignedispo).Value = TableauT(i)
                Sheets("Auto").Range("U" & lignedispo).Value = TableauU(i)
                Sheets("Auto").Range("V" & lignedispo).Value = TableauV(i)
                Sheets("Auto").Range("W" & lignedispo).Value = TableauW(i)
                Sheets("Auto").Range("X" & lignedispo).Value = TableauX(i)
                
                'passer à la ligne disponible suivante
                lignedispo = lignedispo + 1
                
            
            Next i
            
        ' La colonne "B" contient la valeur "d", on copie la ligne
        Else
            Sheets("Auto").Range("A" & lignedispo & ":AM" & lignedispo).Value = Sheets("Split").Range("A" & ligneencours & ":AM" & ligneencours).Value
            'passer à la ligne disponible suivante
            lignedispo = lignedispo + 1
    
        End If
    
        'passer à la ligne à traiter suivante
        ligneencours = ligneencours + 1
    
    Loop
    
    
    End Sub
    

    Dites moi si c'est ok pour vous, et n'hésitez pas si vous avez besoin d'explication sur la macro.

    Bonne fin de week-end,

    Laurent Dumont


    Laurent Dumont PRESTINFORM - Revel

    • Marqué comme réponse EL NONO mardi 27 mars 2018 21:13
    dimanche 18 février 2018 18:12

Toutes les réponses

  • Bonjour,

    vous pourriez mettre votre document à disposition sur un partage de type onedrive par exemple.

    Votre besoin est il pour un document unique ou pensez vous avoir à refaire cette opération sur d'autres documents?


    Laurent Dumont PRESTINFORM - Revel

    lundi 29 janvier 2018 09:24
  • Bonjour et merci de vous intéresser à mon problème :-)

    En fait, je n'ai pas pu joindre le fichier ni montrer une copie d'écran car je n'ai pas assez de droit dans ce forum.

    J'ai mis le fichier sur OneDrive  :  https://1drv.ms/f/s!AntYHE-NnPgIdSA2-vBcEXPNWZc

    J'aurai à refaire cette manipulation sur d'autres fichiers avec un nombre de colonnes plus grand mais avec le même principe : Créer autant de lignes que celles des cellules où il y en a plusieurs et recopier dans chacune de ces lignes les informations des cellules où il n'y a qu'une information.

    Le fichier aidera à comprendre

    Encore merci pour votre aide

    Salutations Nono

    samedi 3 février 2018 17:33
  • Bonjour,

    désolé pour le délai, mais je crois que cela devrait répondre à votre besoin

    Sub splitcells()
        'création d'une variable par colonne à traiter
        Dim TableauT() As String
        Dim TableauU() As String
        Dim TableauV() As String
        Dim TableauW() As String
        Dim TableauX() As String
        
        'variable de boucle
        Dim i As Integer
        
        'Variables de ligne de travail
        Dim lignedispo As Integer
        Dim lignetraitee As Integer
    
    'Initialisation des lignes au numéro 2 (1er = entête)
    lignedispo = 2
    ligneencours = 2
    
    
    'Tant que la cellule de la colonne T n'est pas vide, on continue le traitement
    Do While Not (IsEmpty(Sheets("Split").Range("T" & ligneencours)))
    
    
    'Créations de tableaux pour les colonnes à traiter
    TableauT = Split(Sheets("Split").Range("T" & ligneencours).Value, vbLf)
    TableauU = Split(Sheets("Split").Range("U" & ligneencours).Value, vbLf)
    TableauV = Split(Sheets("Split").Range("V" & ligneencours).Value, vbLf)
    TableauW = Split(Sheets("Split").Range("W" & ligneencours).Value, vbLf)
    TableauX = Split(Sheets("Split").Range("X" & ligneencours).Value, vbLf)
    
    
    
    'boucle sur le tableau de la colonne T
    For i = 0 To UBound(TableauT)
    
        'Copie de la ligne complète du tableau source
        Sheets("Auto").Range("A" & lignedispo & ":AM" & lignedispo).Value = Sheets("Split").Range("A" & ligneencours & ":AM" & ligneencours).Value
        
        'Copie de la ligne souhaitée à la place de la cellule "multi lignes"
        
        Sheets("Auto").Range("T" & lignedispo).Value = TableauT(i)
        Sheets("Auto").Range("U" & lignedispo).Value = TableauU(i)
        Sheets("Auto").Range("V" & lignedispo).Value = TableauV(i)
        Sheets("Auto").Range("W" & lignedispo).Value = TableauW(i)
        Sheets("Auto").Range("X" & lignedispo).Value = TableauX(i)
        
        'passer à la ligne disponible suivante
        lignedispo = lignedispo + 1
        
    
    Next i
    
    'passer à la ligne à traiter suivante
    ligneencours = ligneencours + 1
    
    
    Loop
    
    
    End Sub
    
    
     


    Pour cela j'ai créé une feuille vide nommée "Auto" ou j'ai manuellement recopié l'entête

    Cela est il clair pour vous et réponds à votre besoin?

    Bonne journée,




    Laurent Dumont PRESTINFORM - Revel

    vendredi 9 février 2018 09:24
  • Bonjour,

    Merci Beaucoup de votre aide. C'est parfait et ça correspond exactement à l'attendu. :-)

    Excellent weekend

    Salutations  Nono

    samedi 10 février 2018 09:48
  • Avec plaisir.

    N'hésitez pas à demander un complément d'informations si besoin.

    Si une fois testé, tout est ok pour vous, merci de marquer le sujet résolu.

    Bon week-end.


    Laurent Dumont PRESTINFORM - Revel

    samedi 10 février 2018 10:02
  • Bonjour,

    Je reviens vers vous car je me suis rendu compte que j'ai oublié un cas qui bloque la macro.

    En fait, la cellule T peut être parfois vide lorsque que le type (colonne B) est différent. C'est un autre champs (Presta colonne Y) qui est normalement vide (mais pas toujours) qui est pris en compte. 

    Dans mon exemple, il faudrait que si le type est "D", la macro recopie la ligne complète dans le tableau auto et passe au traitement de la ligne suivante plutôt que de s'arrêter.

    J'ai essayé de modifier le T en B dans l'instruction suivante mais ça ne me recopie pas la ligne 6 dans le tableau "Auto"

    'Tant que la cellule de la colonne T n'est pas vide, on continue le traitement
    Do While Not (IsEmpty(Sheets("Split").Range("T" & ligneencours)))

    J'ai mis à jour le fichier à tester ici : https://1drv.ms/f/s!AntYHE-NnPgIdSA2-vBcEXPNWZc

    Merci d'avance de votre aide

    Bon weekend

    Nono

    samedi 17 février 2018 09:58
  • Bonsoir,

    je crois qu'avec cette version de la macro on s'approche de votre besoin:

    - On ne teste plus si la colonne T est vide, mais on fait ce test sur la colonne B

    - On teste ensuite la valeur de la cellule ("B" & ligneencours"), et si elle est égale à "d" (test en minuscule), on effectue un traitement spécifique (uniquement copier/coller la ligne)

    Sub splitcells()
        
        'copie entête Feuille Split dans feuille Auto (à créer manuellement)
        Sheets("Split").Select
        Range("A1:AM1").Select
        Selection.Copy
        Sheets("Auto").Select
        Range("A1").Select
        ActiveSheet.Paste
        
           
        'création d'une variable par colonne à traiter
        Dim TableauT() As String
        Dim TableauU() As String
        Dim TableauV() As String
        Dim TableauW() As String
        Dim TableauX() As String
        
        'variable de boucle
        Dim i As Integer
        
        'Variables de ligne de travail
        Dim lignedispo As Integer
        Dim lignetraitee As Integer
    
    'Initialisation des lignes au numéro 2 (1er = entête)
    lignedispo = 2
    ligneencours = 2
    
    'Tant que la cellule de la colonne B n'est pas vide, on continue le traitement
    Do While Not (IsEmpty(Sheets("Split").Range("B" & ligneencours)))
    
        ' Si la Colonne "B" contient une autre valeur que "d" (comparaison forcée en minuscule), on traite les données multiples
        If Not (LCase(Sheets("Split").Range("B" & ligneencours).Value) = "d") Then
            
            'Créations de tableaux pour les colonnes à traiter
            TableauT = Split(Sheets("Split").Range("T" & ligneencours).Value, vbLf)
            TableauU = Split(Sheets("Split").Range("U" & ligneencours).Value, vbLf)
            TableauV = Split(Sheets("Split").Range("V" & ligneencours).Value, vbLf)
            TableauW = Split(Sheets("Split").Range("W" & ligneencours).Value, vbLf)
            TableauX = Split(Sheets("Split").Range("X" & ligneencours).Value, vbLf)
            
            
            
            'boucle sur le tableau de la colonne T
            For i = 0 To UBound(TableauT)
            
                'Copie de la ligne complète du tableau source
                Sheets("Auto").Range("A" & lignedispo & ":AM" & lignedispo).Value = Sheets("Split").Range("A" & ligneencours & ":AM" & ligneencours).Value
                
                'Copie de la ligne souhaitée à la place de la cellule "multi lignes"
                
                Sheets("Auto").Range("T" & lignedispo).Value = TableauT(i)
                Sheets("Auto").Range("U" & lignedispo).Value = TableauU(i)
                Sheets("Auto").Range("V" & lignedispo).Value = TableauV(i)
                Sheets("Auto").Range("W" & lignedispo).Value = TableauW(i)
                Sheets("Auto").Range("X" & lignedispo).Value = TableauX(i)
                
                'passer à la ligne disponible suivante
                lignedispo = lignedispo + 1
                
            
            Next i
            
        ' La colonne "B" contient la valeur "d", on copie la ligne
        Else
            Sheets("Auto").Range("A" & lignedispo & ":AM" & lignedispo).Value = Sheets("Split").Range("A" & ligneencours & ":AM" & ligneencours).Value
            'passer à la ligne disponible suivante
            lignedispo = lignedispo + 1
    
        End If
    
        'passer à la ligne à traiter suivante
        ligneencours = ligneencours + 1
    
    Loop
    
    
    End Sub
    

    Dites moi si c'est ok pour vous, et n'hésitez pas si vous avez besoin d'explication sur la macro.

    Bonne fin de week-end,

    Laurent Dumont


    Laurent Dumont PRESTINFORM - Revel

    • Marqué comme réponse EL NONO mardi 27 mars 2018 21:13
    dimanche 18 février 2018 18:12
  • Bonsoir,  Vraiment super !

    Ça fonctionne parfaitement cette fois. Je pense que je n'hésiterai pas à revenir vers vous pour d'autres sujets que j'ai "sur le feu".

    Encore merci

    Une dernière petite aide : Je ne vois pas où passer le sujet en résolu ?

    Salutations   Nono


    • Modifié EL NONO vendredi 23 février 2018 20:43
    vendredi 23 février 2018 20:40