XL 2019 VBA Une ligne vers plusieurs colonnes

Sylveo · 28 Juillet 2023

Bonjour à tous,

Je cherche à réaliser un code VBA qui me permet de couper une plage de données vers une seule ligne et inversement.
J'ai déjà un code qui marche bien, mais je souhaiterais qu'il soit sur une plage fixe.
Et il marche malheureusement que dans le sens "plages vers une ligne".

Je ne sais pas comment coder ça en peu de ligne. J'y arrive, mais cellule par cellule.

Si l'un de vous connait le code pour cette manipulation, je suis plus que preneur.

Merci d'avance.
Sylveo.

fanch55 · 28 Juillet 2023

Bonjour,
Testez le code ci-dessous :

VB:

Sub ConvertRangeToGroupOfColumns()

Dim Range1 As Range, Range2 As Range, Rng As Range
Dim RowIndex As Integer, Nc As Integer, G As Variant, I As Integer

    xTitleId = "Xl-Downloads"
    Set Range1 = Application.Selection
    Set Range1 = Application.InputBox("Source Ranges:", xTitleId, Range1.Address, Type:=8)
    Nc = Range1.Cells(Range1.Cells.Count).End(xlToLeft).Column
    Set Range2 = Application.InputBox("Convert to (single cell):", xTitleId, Type:=8)
    G = Application.InputBox("Columns by group :", xTitleId, Nc, Type:=1)
    RowIndex = 0
    Application.ScreenUpdating = False
        For Each Rng In Range1.Rows
            For I = 1 To Nc Step G
                Rng.Cells(I).Resize(, G).Copy
                Range2.Offset(RowIndex).PasteSpecial Paste:=xlPasteAll ' , Transpose:=True
                RowIndex = RowIndex + 1
            Next
        Next
        Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Cousinhub · 29 Juillet 2023

Bonjour,
En utilisant Power Query (en natif dans ta version d'Excel) pour passer d'une ligne à un tableau.
Le code :

PowerQuery:

let
    Source = Excel.CurrentWorkbook(){[Name="T_Data"]}[Content],
    Transpose = Table.Transpose(Source),
    Table = Table.FromRows(List.Split(Transpose[Column1],5), {"Descriptif", "Prix U", "Qté","Prix HT","TVA"})
in
    Table

Pour mettre à jour, clic droit dans la requête, "Actualiser"
Bonne journée

fanch55 · 29 Juillet 2023

Salut @Cousinhub ,
Par curiosité, tu t'en sors comment avec plusieurs lignes de données ?

Cousinhub · 29 Juillet 2023

Hello @fanch55

Une autre logique, très peu différente

PowerQuery:

let
    Source = Excel.CurrentWorkbook(){[Name="T_Data2"]}[Content],
    AjtIdx = Table.AddIndexColumn(Source, "Index", 1, 1, Int64.Type),
    UnPivot = Table.UnpivotOtherColumns(AjtIdx, {"Index"}, "Attribut", "Valeur"),
    Table = Table.FromRows(List.Split(UnPivot[Valeur],5), {"Descriptif", "Prix U", "Qté","Prix HT","TVA"})
in
    Table

Edit : version également valable pour une seule ligne

fanch55 · 29 Juillet 2023

Oki, pas mal ...
Et si tu dois conserver le type de cellules et de couleurs ?

Cousinhub · 29 Juillet 2023

fanch55 à dit:
Oki, pas mal ...
Et si tu dois conserver le type de cellules et de couleurs ?

Hi,
C'est pour faire un comparatif avec VBA? Je ne rentrerai pas dans ce jeu, désolé...
Et pour ma part, j'utilise les Tableaux Structurés, donc couleurs et autres éléments de décorations....
A savoir que le format des TS peut être modifié, que les MEFC fonctionnent parfaitement dans les requêtes une fois insérées.
Bonne journée

fanch55 · 29 Juillet 2023

Hi,
C'est juste pour savoir ce qu'on peut faire facilement ou pas avec Pq,
et surtout pour la souplesse de maj sans avoir à modifier le code de Pq .
Je n'ai pas de à priori, que de la curiosité intéressée .
C'est bien évidemment pour faire un comparatif avec Vba,
si Pq est mieux et facilement modulable, je suis pour ce qui est le plus rapide ...

Cousinhub · 29 Juillet 2023

Hi,
Pas de soucis
Question rapidité, je ne pense pas que PQ soit le plus véloce. (du moins, s'il y a peu de données à traiter)
Cependant, comme son nom l'indique, c'est bien pour manipuler des données, i-e importer, transformer, restituer.
Dire que c'est mieux, je ne pourrais le dire, mais perso, j'ai pratiquement cessé le VBA, sauf pour les mises à jour et autres petits trucs, qui facilitent la vie.
Chacun ses préférences, le principal, c'est le résultat, et c'est tout ce qui compte.

Sylveo · 24 Août 2023

fanch55 à dit:

Bonjour,
Testez le code ci-dessous :

VB:

Sub ConvertRangeToGroupOfColumns()

Dim Range1 As Range, Range2 As Range, Rng As Range
Dim RowIndex As Integer, Nc As Integer, G As Variant, I As Integer

    xTitleId = "Xl-Downloads"
    Set Range1 = Application.Selection
    Set Range1 = Application.InputBox("Source Ranges:", xTitleId, Range1.Address, Type:=8)
    Nc = Range1.Cells(Range1.Cells.Count).End(xlToLeft).Column
    Set Range2 = Application.InputBox("Convert to (single cell):", xTitleId, Type:=8)
    G = Application.InputBox("Columns by group :", xTitleId, Nc, Type:=1)
    RowIndex = 0
    Application.ScreenUpdating = False
        For Each Rng In Range1.Rows
            For I = 1 To Nc Step G
                Rng.Cells(I).Resize(, G).Copy
                Range2.Offset(RowIndex).PasteSpecial Paste:=xlPasteAll ' , Transpose:=True
                RowIndex = RowIndex + 1
            Next
        Next
        Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Bonjour,

Déjà, merci beaucoup pour votre aide.

Cependant, ce code reproduit la même ligne, seul le nombre de colonne reproduit change selon la valeur qu'on choisi.

Je n'arrive pas à lui faire mettre la suite de la ligne source vers la ligne suivante.

Merci d'avance.

Sylveo · 24 Août 2023

Cousinhub à dit:
Bonjour,
En utilisant Power Query (en natif dans ta version d'Excel) pour passer d'une ligne à un tableau.
Le code :

PowerQuery:

let Source = Excel.CurrentWorkbook(){[Name="T_Data"]}[Content], Transpose = Table.Transpose(Source), Table = Table.FromRows(List.Split(Transpose[Column1],5), {"Descriptif", "Prix U", "Qté","Prix HT","TVA"}) in Table

Pour mettre à jour, clic droit dans la requête, "Actualiser"
Bonne journée

Bonjour,

Cela semble effectivement marcher, mais je souhaite rester en VBA sans faire appel au cloud.

Merci d'avance.

fanch55 · 24 Août 2023

Sylveo à dit:
Bonjour,
Déjà, merci beaucoup pour votre aide.
Cependant, ce code reproduit la même ligne, seul le nombre de colonne reproduit change selon la valeur qu'on choisi.
Je n'arrive pas à lui faire mettre la suite de la ligne source vers la ligne suivante.
Merci d'avance.

Salut, une petite "bévue" dans le code pour ne pas traiter une ligne entière sans raison.
Correction:

VB:

Sub Lignecolonne()

Dim Range1 As Range, Range2 As Range, Rng As Range
Dim RowIndex As Integer, Nc As Integer, G As Variant, I As Integer

    xTitleId = "Xl-Downloads"
    On Error Resume Next
        Set Range1 = Application.InputBox("Source Ranges:", xTitleId, Selection.Address, Type:=8)
    On Error GoTo 0
    If Not Range1 Is Nothing Then
        If Range1.Cells(Range1.Columns.Count) = "" Then
            Nc = Range1.Cells(Range1.Columns.Count).End(xlToLeft).Column
        Else
            Nc = Range1.Columns.Count
        End If
        Set Range2 = Application.InputBox("Convert to (single cell) :", xTitleId, Type:=8)
        G = Application.InputBox("Columns by group :", xTitleId, Nc, Type:=1)
        RowIndex = 0
        Application.ScreenUpdating = False
            For Each Rng In Range1.Rows
                For I = 1 To Nc Step G
                    Rng.Cells(I).Resize(, G).Copy
                    Range2.Offset(RowIndex).PasteSpecial Paste:=xlPasteAll ' , Transpose:=True
                    RowIndex = RowIndex + 1
                Next
            Next
            Application.CutCopyMode = False
        Application.ScreenUpdating = True
    End If
End Sub

Sylveo · 24 Août 2023

Merci beaucoup, ça marche parfaitement et dans les deux sens.

Je l'ai même automatisé sur une plage donnée fixe :

Code:

Sub Lignecolonne()

Dim Range1 As Range, Range2 As Range, Rng As Range
Dim RowIndex As Integer, Nc As Integer, G As Variant, I As Integer

    xTitleId = "Xl-Downloads"
    On Error Resume Next
        Set Range1 = Range("A2:T2")
    On Error GoTo 0
    If Not Range1 Is Nothing Then
        If Range1.Cells(Range1.Columns.Count) = "" Then
            Nc = Range1.Cells(Range1.Columns.Count).End(xlToLeft).Column
        Else
            Nc = Range1.Columns.Count
        End If
        Set Range2 = Sheets("Resultat").Range("A2")
        G = 5
        RowIndex = 0
        Application.ScreenUpdating = False
            For Each Rng In Range1.Rows
                For I = 1 To Nc Step G
                    Rng.Cells(I).Resize(, G).Copy
                    Range2.Offset(RowIndex).PasteSpecial Paste:=xlPasteAll ' , Transpose:=True
                    RowIndex = RowIndex + 1
                Next
            Next
            Application.CutCopyMode = False
        Application.ScreenUpdating = True
    End If
   Sheets("Resultat").Activate
End Sub

Cousinhub · 24 Août 2023

Sylveo à dit:
Bonjour,

Cela semble effectivement marcher, mais je souhaite rester en VBA sans faire appel au cloud.

Merci d'avance.

Bonsoir,
Sauf erreur de ma part, (ce dont j'en suis sûr), je n'ai jamais fait référence à un quelconque "nuage".....
Power Query est juste une fonctionnalité installée en natif dans ta version, tout comme tout plein d'autres, si peu utilisées...
Bonne continuation

XL 2019 VBA Une ligne vers plusieurs colonnes

Sylveo

XLDnaute Nouveau

Pièces jointes

fanch55

XLDnaute Barbatruc

Cousinhub

XLDnaute Barbatruc

Pièces jointes

fanch55

XLDnaute Barbatruc

Cousinhub

XLDnaute Barbatruc

Pièces jointes

fanch55

XLDnaute Barbatruc

Cousinhub

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

Cousinhub

XLDnaute Barbatruc

Sylveo

XLDnaute Nouveau

Pièces jointes

Sylveo

XLDnaute Nouveau

fanch55

XLDnaute Barbatruc

Sylveo

XLDnaute Nouveau

Pièces jointes

Cousinhub

XLDnaute Barbatruc

Discussions similaires