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

L

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

  • transposer fichier ent test.xlsx
    359.2 KB · Affichages: 9
Trier par date Trier par votes
S

soan

XLDnaute Barbatruc
Inactif
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

  • transposer fichier ent test.xlsm
    362.8 KB · Affichages: 7
Dernière édition:
Vote positif 0 Vote négatif
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
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

  • transposer fichier ent test.xlsm
    946.1 KB · Affichages: 5
Vote positif 0 Vote négatif
L

Loïc DUBOIS

XLDnaute Occasionnel
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
 
Vote positif 0 Vote négatif
job75

job75

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

  • transposer(1).xlsm
    360.1 KB · Affichages: 2
Vote positif 0 Vote négatif
job75

job75

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

  • transposer(2).xlsm
    360.3 KB · Affichages: 3
Vote positif 0 Vote négatif
Etoto

Etoto

XLDnaute Barbatruc
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.
 
Vote positif 0 Vote négatif
L

Loïc DUBOIS

XLDnaute Occasionnel
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.
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
L

Loïc DUBOIS

XLDnaute Occasionnel
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
Cliquez pour agrandir...
Merci beaucoup,

Je vais tester cela une fois que j'ai fini avec la transposition :)
 
Vote positif 0 Vote négatif
L

Loïc DUBOIS

XLDnaute Occasionnel
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.
Cliquez pour agrandir...
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.
 
Vote positif 0 Vote négatif

Discussions similaires

S
  • Question
XL 2016 Transposer colonnes sur lignes
2 3
Réponses
32
Affichages
1 K
soumus
S
rastafouette
  • Question
Microsoft 365 "transposition" de tableau
Réponses
3
Affichages
264
djidji59430
djidji59430
W
  • Résolu(e)
XL 2016 Gestion de liste transposée dans une autre feuille avec décalage d'une colonne et exclusion de certains éléments
Réponses
9
Affichages
419
Webperegrino
W
W
  • Résolu(e)
XL 2016 Problème de comptage pour trouver les trois meilleurs
2
Réponses
19
Affichages
783
Webperegrino
W
N
  • Question
Microsoft 365 afficher/masquer des lignes en fonction de la valeur d'une cellule qui aura été renseignée par une autre feuille (via un copier/collé automatique)
Réponses
5
Affichages
451
Nel'
N
C
  • Question
Microsoft 365 Transposer des valeurs en 2 colonnes en fonction d'une référence produit
Réponses
9
Affichages
624
Cagnet
C
C
  • Question
XL 2021 copier des donnees en dessous un mot
Réponses
3
Affichages
325
cg1980
C
Captain NRJ
  • Question
XL 2016 casse tete (pour moi)
Réponses
5
Affichages
333
vgendron
vgendron
Lisette
  • Question
Microsoft 365 VBA : copier / coller d'un onglet à l'autre en fonction d'une valeur
Réponses
8
Affichages
553
Lisette
Lisette
cathodique
  • Résolu(e)
XL 2010 Sauts de page
2
Réponses
18
Affichages
893
TooFatBoy
TooFatBoy

Membres actuellement en ligne

1 membres et 43 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 127
Messages
2 116 534
Membres
112 771
dernier inscrit
mikadu49