XL 2016 Transposer toutes les trois lignes l'un en dessous de l'autre

[Loïc DUBOIS]

Bonjour à tous,

J'espère que vous allez bien ?

Je créé cette discussion aujourd'hui car j'ai un problème que je n'arrive pas à resoudre.

J'ai un fichier d'environ 65k lignes. Je voudrais prendre les trois première lignes puis les coller en transposer. Puis prendre les trois suivantes et les coller en dessous du collage précédent et ainsi de suite.

Je vous joins un fichier exemple. Feuille 1 : mon fichier de base. Feuille 2 : Ligne 1 à 3 coller en transposer et en dessous ligne 4 à 6 coller en transposer. Etant donné ma grande base de données, il faut que je puisse automatiser cela.

J'espère que vous serez en mesure de m'aider.

Si vous avez besoin de précision n'hésitez pas.

Merci d'avance,

Loïc DUBOIS

 

[soan]

moi, je n'ai jamais eu besoin d'utiliser des fichiers csv,
alors j'connais pas ! j'ai fait l'exo pour un .xlsm 😜

soan

 

[Loïc DUBOIS]

moi, je n'ai jamais eu besoin d'utiliser des fichiers csv,
alors j'connais pas ! j'ai fait l'exo pour un .xlsm 😜

soan

C'est ce que j'avais en tête au début également 😂 parce que je n'avais pas pensé à la limite des lignes.

C'était une très bonne solution en tout cas (fonctionne rapidement).

Loïc

 

[job75]

Bonjour à tous,

On peut stocker le tableau transposé dans une ListBox :

Sub Transpose_ListBox()
Dim tablo, ncol%, i&, j%, n&
With [A1].CurrentRegion
    tablo = .Resize(3 * Application.RoundUp(.Rows.Count / 3, 0)) 'matrice, plus rapide
End With
ncol = UBound(tablo, 2)
ReDim a(1 To ncol * UBound(tablo) / 3, 1 To 3)
For i = 1 To UBound(tablo) Step 3
    For j = 1 To ncol
        n = n + 1
        a(n, 1) = tablo(i, j)
        a(n, 2) = tablo(i + 1, j)
        a(n, 3) = tablo(i + 2, j)
Next j, i
If n Then ListBox1.List = a Else ListBox1.Clear
End Sub

Aucun problème avec un tableau source de 63 750 lignes, la macro s'exécute chez moi en 6 secondes.

A+

 

[job75]

Bonjour Loîc DUBOIS, le forum,

Avec la ListBox on peut copier et coller les lignes sélectionnées, fichier (4) :

Sub Coller()
Dim i&, n&
With Sheets("Coller")
    .Cells.Delete 'RAZ
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) Then
            n = n + 1
            .Cells(n, 1) = ListBox1.List(i, 0)
            .Cells(n, 2) = ListBox1.List(i, 1)
            .Cells(n, 3) = ListBox1.List(i, 2)
        End If
    Next
    .Columns.AutoFit 'ajuste les largeurs
    .Activate 'facultatif
End With
End Sub

A+