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

Créer une discussion
Répondre

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 !

S'inscrire
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

Trier par date Trier par votes
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:
Vote positif 0 Vote négatif
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

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

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

Vote positif 0 Vote négatif
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
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
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
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
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- 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

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
511
Webperegrino
W
X
  • Question Question
XL 2021 Transformation de données sur une ligne en plusieurs lignes
Réponses
9
Affichages
330
xavieralvaro
X
M
  • Question 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
443
JHA
J
Magnio
  • Question Question
XL 2016 Transfert de données d'un tableau en différenciant les libellés
Réponses
8
Affichages
578
Magnio
Magnio
D
  • Question Question
Microsoft 365 Cas réel - avec problème complexe sur de la prevision de match en evitant les doublons
Réponses
1
Affichages
843
Dock91
D
C
  • Question Question
XL 2013 [VBA]Créer un nombre de ligne en fonction d'un certain nombre de colonne et remplir ces lignes avec certaines valeurs
Réponses
6
Affichages
1 K
CaptainSalt31
C
L
  • Résolu(e)
Microsoft 365 Insérer des lignes dans un tableau en décalant celles du dessous
2 3
Réponses
35
Affichages
3 K
Léraud Florian
L
Cybertoto
  • Question Question
XL 2016 copier toutes les lignes entre janvier et fevrier
Réponses
4
Affichages
739
Cybertoto
Cybertoto
oguruma
Transposer en colonnes des blocs de données en lignes - via formules
Réponses
0
Affichages
522
oguruma
oguruma
T
  • Résolu(e)
Microsoft 365 Création d'une formule de recherche
Réponses
6
Affichages
834
TooFatBoy
TooFatBoy
Y
  • Question Question
XL 2019 Afficher les 5 lignes en dessous d'une valeur
Réponses
5
Affichages
749
Yassin9
Y
P
  • Résolu(e)
Microsoft 365 VBA - EXCEL Compiler plusieurs lignes d'une extraction en un minimum de lignes
Réponses
13
Affichages
986
Pb68
P
L
  • Question Question
XL 2016 Supprimer les doublons (avec 4 colonnes) et ne garder que la ligne la plus ancienne (colonne A)
2 3 4
Réponses
46
Affichages
4 K
ChTi160
ChTi160
L
  • Question Question
XL 2016 Split une cellule selon les espaces
Réponses
3
Affichages
399
patricktoulon
patricktoulon
K
  • Résolu(e)
XL 2019 Copier Seulement les lignes affichée après un filtre de tableau
Réponses
9
Affichages
2 K
Kushi
K
E
  • Résolu(e)
XL 2016 vérifier entre deux fichiers que les valeurs d'une colonne correspondent en vba
Réponses
8
Affichages
718
Excellerateur
E
E
  • Question Question
XL 2013 transposer colonne en ligne de facon conditionnelle
Réponses
12
Affichages
1 K
mapomme
mapomme
T
  • Question Question
XL 2019 copier de bloc de cellules pour les coller en transposer
Réponses
1
Affichages
864
Hasco
Hasco
S
  • Question Question
XL 2010 extraire des lignes selon critère repris dans une colonne
Réponses
7
Affichages
1 K
JHA
J
F
  • Résolu(e)
Microsoft 365 Macro pour copier des lignes et les coller à l'emplacement de la cellule sélectionnée
Réponses
2
Affichages
1 K
Fanou44
F
Retour