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

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Loïc DUBOIS

XLDnaute Occasionnel
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
 

Pièces jointes

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
 

Pièces jointes

Dernière édition:
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.
 

Pièces jointes

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
 
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+
 

Pièces jointes

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
 

Pièces jointes

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 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é".

1654707466777.png

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
 
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 🙂
 
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.
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour