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

C
  • Question
Microsoft 365 Transposer des valeurs en 2 colonnes en fonction d'une référence produit
Réponses
9
Affichages
296
Cagnet
C
C
  • Question
XL 2021 copier des donnees en dessous un mot
Réponses
3
Affichages
136
cg1980
C
C
  • Question
transposer lignes en colonnes
Réponses
1
Affichages
372
sousou
sousou
M
  • Question
XL 2021 Rechercher dans une matrice le texte d'une cellule et copier les 10 lignes situées en dessous de ce texte retrouvé
Réponses
2
Affichages
134
JHA
J
jeanmi
  • Question
XL 2010 supprimer les lignes en doubles dans un tableau
Réponses
4
Affichages
212
jeanmi
jeanmi
Magnio
  • Question
XL 2016 Transfert de données d'un tableau en différenciant les libellés
Réponses
8
Affichages
199
Magnio
Magnio
G
  • Question
XL 2019 Transformer des lignes en colonnes mais conserver la colonne 1 en colonne
Réponses
2
Affichages
113
gafp
G
S
  • Question
XL 2019 Copier/coller en transposer en nombre
Réponses
4
Affichages
344
stefb1968
S
L
  • Question
XL 2019 formule index equiv en VBA
Réponses
10
Affichages
506
Loïc DUBOIS
L
L
  • Question
XL 2019 Optimiser un code VBA dans un grand jeu de données
Réponses
4
Affichages
583
Loïc DUBOIS
L

Membres actuellement en ligne

20 membres et 315 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
312 167
Messages
2 085 895
Membres
103 021
dernier inscrit
Sergyl75