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

Loïc DUBOIS · 8 Juin 2022

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 · 8 Juin 2022

Bonjour Loïc,

* sur "Feuil2", y'a aucune donnée : la feuille est entièrement vide.

* va sur "Feuil1", et fais Ctrl e ➯ travail effectué.

code VBA (21 lignes) :

VB:

Option Explicit

Sub Essai()
  If ActiveSheet.Name <> "Feuil1" Then Exit Sub
  If IsEmpty([A1]) Then Exit Sub
  Dim dcol%: dcol = Cells(1, Columns.Count).End(1).Column
  Dim n&: n = Cells(Rows.Count, 1).End(3).Row: If n < 3 Then Exit Sub
  Dim T, i&, j%, lig&: T = [A1].Resize(n, dcol): Application.ScreenUpdating = 0
  Worksheets("Feuil2").Select: Columns("A:C").ClearContents
  For i = 1 To n Step 3
    For j = 1 To dcol
      lig = lig + 1
      With Cells(lig, 1)
        .Value = T(i, j)
        .Offset(, 1) = T(i + 1, j)
        .Offset(, 2) = T(i + 2, j)
      End With
    Next j
  Next i
End Sub

edit : version améliorée dans mon post #22.

soan

sylvanu · 8 Juin 2022

Bonjour Loïc, Soan,
En passant par des arrays on est beaucoup plus rapide, par ex avec :

VB:

Sub EssaiSylvanu()
  Sheets("Feuil1").Select
  If ActiveSheet.Name <> "Feuil1" Then Exit Sub
  If IsEmpty([A1]) Then Exit Sub
  Sheets("Entete").Select
  Worksheets("Feuil2").Columns("A:C").ClearContents
  Dim Tin, Tout, D1, D2%, Indice%, L%, C%
  Tin = Sheets("Feuil1").[A1].CurrentRegion
  D1 = Int((UBound(Tin) / 3) * (1 + UBound(Tin, 2)))
  Indice = 0
  ReDim Tout(D1, 2)
  For L = 1 To UBound(Tin) Step 3
    For C = 1 To UBound(Tin, 2)
        Tout(Indice, 0) = Tin(L + 0, C)
        Tout(Indice, 1) = Tin(L + 1, C)
        Tout(Indice, 2) = Tin(L + 2, C)
        Indice = Indice + 1
    Next C
  Next L
  Sheets("Feuil2").[A1].Resize(UBound(Tout, 1), 1 + UBound(Tout, 2)) = Tout
End Sub

En PJ une comparaison. Sur mon PC par accès cellules je suis à 7.3s alors que par array à 0.33s.

job75 · 8 Juin 2022

Bonjour Loïc DUBOIS, soan, sylvanu, le forum,

Attention, avec un tableau de 65 000 lignes le tableau transposé fait 190*65000/3 = 4 116 667 lignes.

A+

Loïc DUBOIS · 8 Juin 2022

Bonjour à tous,

Merci pour vos commentaires cela fonctionne parfaitement.
Effectivement comme l'indique Job75, la limite en terme de ligne est atteinte.
Connaissez-vous un moyen s'il existe d'augmenter cette limite vers les 3 millions ?

Merci d'avance,

Loïc

sylvanu · 8 Juin 2022

Bonjour à tous,

Loïc DUBOIS à dit:
Connaissez-vous un moyen s'il existe d'augmenter cette limite vers les 3 millions ?

XL est limité à 2^20 lignes, soit 1 048 576 lignes.
Le seul moyen serait de splitter le tableau en 3 avec 3 fois 3 colonnes ou encore sur trois feuilles.

job75 · 8 Juin 2022

Oui, ou de créer un fichier texte avec cette macro :

VB:

Sub Fichier_texte()
Dim tablo, ncol%, n%, i&, j%
With [A1].CurrentRegion
    tablo = .Resize(3 * Application.RoundUp(.Rows.Count / 3, 0)) 'matrice, plus rapide
End With
ncol = UBound(tablo, 2)
n = FreeFile
Open ThisWorkbook.Path & Application.PathSeparator & "Fichier texte.txt" For Output As #n
For i = 1 To UBound(tablo) Step 3
    For j = 1 To ncol
        Print #n, tablo(i, j) & vbTab & tablo(i + 1, j) & vbTab & tablo(i + 2, j)
Next j, i
Close #n
End Sub

A+

job75 · 8 Juin 2022

Pour tester j'ai copié le tableau source sur 63 750 lignes, on obtient un fichier de 60 Mo.

Chez moi le fichier texte est créé en 11 secondes, il contient 4 037 500 lignes et pèse 85,8 Mo.

Deadpool_CC · 8 Juin 2022

sinon ... dispatcher les données sur plusieurs feuilles basées sur les dates (une feuille par années ou par trim ou par mois selon ton jeu de données réelles)

job75 · 8 Juin 2022

Avec ce fichier (2) on évite les lignes vides :

VB:

Sub Fichier_texte()
Dim tablo, ncol%, n%, i&, j%, x$
With [A1].CurrentRegion
    tablo = .Resize(3 * Application.RoundUp(.Rows.Count / 3, 0)) 'matrice, plus rapide
End With
ncol = UBound(tablo, 2)
n = FreeFile
Open ThisWorkbook.Path & Application.PathSeparator & "Fichier texte.txt" For Output As #n
For i = 1 To UBound(tablo) Step 3
    For j = 1 To ncol
        x = tablo(i, j) & vbTab & tablo(i + 1, j) & vbTab & tablo(i + 2, j)
        If x <> vbTab & vbTab Then Print #n, x 'évite les lignes vides
Next j, i
Close #n
End Sub

Etoto · 8 Juin 2022

Hello à tous,

Je me posais la question, exporter le tableau sur Access serait pas un bonne idée ? Access n'a pas de limites de ligne tant que le fichier fait moins de 2 GO, ça passe tranquille non ? Je précise que c'est probable que mon idée soit loin d'être la meilleure mais je me dis que pour de très gros tableaux, Access peut être très utile.

Merci de me dire si une idée comme celle-ci est réalisable.

Si mon idée n'est absolument pas compatible avec ce projet, je m'excuse d'avance.

Loïc DUBOIS · 8 Juin 2022

sylvanu à dit:

Bonjour Loïc, Soan,
En passant par des arrays on est beaucoup plus rapide, par ex avec :

VB:

Sub EssaiSylvanu()
  Sheets("Feuil1").Select
  If ActiveSheet.Name <> "Feuil1" Then Exit Sub
  If IsEmpty([A1]) Then Exit Sub
  Sheets("Entete").Select
  Worksheets("Feuil2").Columns("A:C").ClearContents
  Dim Tin, Tout, D1, D2%, Indice%, L%, C%
  Tin = Sheets("Feuil1").[A1].CurrentRegion
  D1 = Int((UBound(Tin) / 3) * (1 + UBound(Tin, 2)))
  Indice = 0
  ReDim Tout(D1, 2)
  For L = 1 To UBound(Tin) Step 3
    For C = 1 To UBound(Tin, 2)
        Tout(Indice, 0) = Tin(L + 0, C)
        Tout(Indice, 1) = Tin(L + 1, C)
        Tout(Indice, 2) = Tin(L + 2, C)
        Indice = Indice + 1
    Next C
  Next L
  Sheets("Feuil2").[A1].Resize(UBound(Tout, 1), 1 + UBound(Tout, 2)) = Tout
End Sub

En PJ une comparaison. Sur mon PC par accès cellules je suis à 7.3s alors que par array à 0.33s.

Re bonjour,

Je me permets de te renvoyer ce message car je ne comprend pas, à chaque fois que j'essaie de lancer le script j'ai un message d'erreur : "Dépassement de capacité".

J'ai essayé avec 13k lignes mais j'ai le même message quand je test avec seulement 800 lignes. As-tu une idée ?
Ps: Lorsque j'essaie avec 18 lignes, cela fonctionne parfaitement.

Merci d'avance,

Loïc

Loïc DUBOIS · 8 Juin 2022

job75 à dit:

Avec ce fichier (2) on évite les lignes vides :

VB:

Sub Fichier_texte()
Dim tablo, ncol%, n%, i&, j%, x$
With [A1].CurrentRegion
    tablo = .Resize(3 * Application.RoundUp(.Rows.Count / 3, 0)) 'matrice, plus rapide
End With
ncol = UBound(tablo, 2)
n = FreeFile
Open ThisWorkbook.Path & Application.PathSeparator & "Fichier texte.txt" For Output As #n
For i = 1 To UBound(tablo) Step 3
    For j = 1 To ncol
        x = tablo(i, j) & vbTab & tablo(i + 1, j) & vbTab & tablo(i + 2, j)
        If x <> vbTab & vbTab Then Print #n, x 'évite les lignes vides
Next j, i
Close #n
End Sub

Merci beaucoup,

Je vais tester cela une fois que j'ai fini avec la transposition

Loïc DUBOIS · 8 Juin 2022

Etoto à dit:
Hello à tous,

Je me posais la question, exporter le tableau sur Access serait pas un bonne idée ? Access n'a pas de limites de ligne tant que le fichier fait moins de 2 GO, ça passe tranquille non ? Je précise que c'est probable que mon idée soit loin d'être la meilleure mais je me dis que pour de très gros tableaux, Access peut être très utile.

Merci de me dire si une idée comme celle-ci est réalisable.

Si mon idée n'est absolument pas compatible avec ce projet, je m'excuse d'avance.

Bonjour,

Merci pour ton idée, malheureusement ce fichier a pour vocation d'aller dans une application, et cette dernière n'accepte que les formats excel ou csv.

sylvanu · 8 Juin 2022

Bonsoir à tous,

Loïc DUBOIS à dit:
"Dépassement de capacité".

Non je n'ai pas d'explication.
Avec votre PJ qui a 375 lignes de 190 colonnes, cela génèrent une liste de 23750 lignes, et je dimensionne mon tableau de sortie à 23875.
Donc loin des limites. Normalement cela devrait marcher.
( à noter que je bosse avec 8Go de Ram, Win10 et XL2007 )

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

Loïc DUBOIS

XLDnaute Occasionnel

Pièces jointes

soan

XLDnaute Barbatruc

Pièces jointes

sylvanu

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Loïc DUBOIS

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Deadpool_CC

XLDnaute Accro

job75

XLDnaute Barbatruc

Pièces jointes

Etoto

XLDnaute Barbatruc

Loïc DUBOIS

XLDnaute Occasionnel

Loïc DUBOIS

XLDnaute Occasionnel

Loïc DUBOIS

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

Discussions similaires