Transposer plusieurs lignes en une seule colonne

Le 18/07/2018 à 12:20

Bonjour tout le monde,

Je suis archi débutante en VBA et j'ai besoin de votre aide. J'ai 4 lignes que je cherche à transposer en une seule colonne.

En gros mon fichier de départ est

id nom pays 2008 2009 2010...2018

x Kia South korea 1 2 3 ......9

y KR South korea 1 2 3 ......9

et ça continue pendant 1000000 lignes comme ça

et je veux avoir (dans le but de faire des panels avec ça)

id nom pays date variable

x Kia South korea 2008 1

x Kia South korea 2009 2

x Kia South korea 2010 3

x Kia South korea 2011 4

x Kia South korea 2012 5

x Kia South korea 2013 6

x Kia South korea 2014 7

Y KR South korea 2008 1

Y KR South korea 2009 2

Y KR South korea 2010 3

Y KR South korea 2011 4

Y KR South korea 2012 5

Y KR South korea 2013 6

Y KR South korea 2014 7

En pj, un petit échantillon de ma base de données.

Je vous remercie

31question-excel.zip (5.23 Ko)
Le 18/07/2018 à 12:26

Bonjour

Faisable sans VBA en 4 clics avec PowerQuery, add on gratuit sur 2010 et intégré à 2016

143transposerpq.xlsx (23.42 Ko)
Le 18/07/2018 à 13:40

Merci pour ta réponse

Est ce que tu peux m'expliquer les 4 cliques s'il te plait?

Le 18/07/2018 à 14:54

Salut dorraEH,

Salut Chris,

@Chris : épatant, le PowerQuery! Que se passe-t-il si la liste de data compte vraiment (je me doute que c'est un clin d'oeil de dorraEH) 1.000.000 de lignes à splitter?

En vieux dinosaure aimant VBA, je me suis pris au jeu...

Un double-clic dans 'Data' démarre la macro.

Même si, réellement, ta liste compte 1.000.000 de lignes (donc 1.000.000 X 11 dates à splitter), les résultats sont répartis en autant de blocs de 5 colonnes que nécessaire dans 'Extract'.

J'ai essayé en recopiant tes données sur 1.000.000 de lignes = 215 secondes pour tout traiter! Il y aurait moyen d'aller plus vite...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tData, tExtract()
'
Application.ScreenUpdating = False
'
Cancel = True
iShRow = Rows.Count
iRow = Range("A" & Rows.Count).End(xlUp).Row
iCol = Cells(1, Columns.Count).End(xlToLeft).Column
sCol = Split(Columns(iCol).Address(ColumnAbsolute:=False), ":")(1)
iIdx = (iRow - 1) * (iCol - 3)
'
With Worksheets("Extract")
    .UsedRange.Delete
    .Range("A1").Value = "Ticker"
    .Range("B1").Value = "Short name"
    .Range("C1").Value = "Country"
    .Range("D1").Value = "Date"
    .Range("E1").Value = "Variable"
    .Range("A1:E1").Interior.Color = RGB(60, 150, 220)
End With
'
iIdxData = 1
tData = Range("A1:" & sCol & iRow).Value
'
For x = 1 To Int(iIdx / (iShRow - 1)) + 1
    iStep = 0
    Erase tExtract
    If iIdx > iShRow Then
        ReDim tExtract(iShRow - 1, 5)
    Else
        ReDim tExtract(iIdx, 5)
    End If
    iTCol = -6 + (x * 7)
    Do While iStep + (iCol - 3) < iShRow - 1 And iIdxData < UBound(tData)
        iIdxData = iIdxData + 1
        For y = 4 To iCol
            iStep = iStep + 1
            For Z = 1 To 3
                tExtract(iStep - 1, Z - 1) = tData(iIdxData, Z)
            Next
            tExtract(iStep - 1, 3) = IIf(y = iCol, "Level", tData(1, y))
            tExtract(iStep - 1, 4) = tData(iIdxData, y)
        Next
    Loop
    sCol1 = Split(Columns(iTCol).Address(ColumnAbsolute:=False), ":")(1)
    sCol2 = Split(Columns(iTCol + 4).Address(ColumnAbsolute:=False), ":")(1)
    With Worksheets("Extract")
        .Range("A1:E1").Copy Destination:=.Range(sCol1 & "1:" & sCol2 & 1)
        .Range(sCol1 & "2:" & sCol2 & UBound(tExtract, 1) + 1).Value = tExtract
    End With
Next
With Worksheets("Extract")
    .Columns.AutoFit
    For x = 1 To Int(iIdx / (iShRow - 1)) + 1
        sCol = Split(Columns(-3 + (x * 7)).Address(ColumnAbsolute:=False), ":")(1)
        .Columns(sCol).ColumnWidth = .Columns(sCol).ColumnWidth + 5
    Next
End With
'
Application.ScreenUpdating = True
'
End Sub

A+

35ticker.xlsm (21.25 Ko)
Le 18/07/2018 à 21:58

Bonjour

curulis57 a écrit :

@Chris : épatant, le PowerQuery! Que se passe-t-il si la liste de data compte vraiment (je me doute que c'est un clin d'oeil de dorraEH) 1.000.000 de lignes à splitter?

Le split fonctionne sur PQ mais la question est que fait-on des 11 000 000 lignes obtenues ?

J'en ai mis 6 000 0000 sur un onglet mais j'ai arrêté là car cela n'a aucun sens

2 solutions pour le prix d'une si la question a un sens....

Le 19/07/2018 à 10:13

Bonjour Chris,

J'ai téléchargé PQ mais je ne sais pas trop comment m'y prendre (je ne connais pas ce "logiciel")

Peux tu m'aider s'il te plait?

Le 19/07/2018 à 14:29

Bonjour

L'as-tu bien installé et activé dans Excel ? Si oui :

Si tu reprends mon exemple,

j'ai commencé par mettre le tableau source sous forme de tableau, ai renommé le tableau Source au lieu de Tableau 1, puis sauvegardé en format xlsx (qui a remplacé le xls depuis plus de 10 ans), fermé puis rouvert le fichier (xls n'est pas compatible avec PowerQuery).

Dans l'onglet PowerQuery : tu as un bouton (au mileu) "Afficher le volet"

Tu vois alors à droite la liste des requêtes PowerQuery

Clic droit sur Source, Modifier : tu passes dans PowerQuery

Là tu vois à droite les actions faites (les intitulés se créent seuls en fonction de l'action) :

  • Source et Type modifié : ces lignes se créent seules quand, depuis une cellule d'un tableau, tu cliques dans Excel sur le bouton "A partir d'un tableau/d'une plage" de l'onglet PowerQuery
  • Tableau croisé dynamique des colonnes supprimé" : j'ai sélectionné les colonnes 2009 à Market Place et ai cliqué sur le boutonSupprimer le tableau croisé dynamique dans l'onglet Transformer
  • Colonnes renommées : j'ai renommé les 2 dernières colonnes

On quitte PowerQuery par le bouton en haut à gauche Fermer et Charger, Tableau : choisir la destination.

Rechercher des sujets similaires à "transposer lignes seule colonne"