Discussion :

[apnw7931]

Bonjour,

pourriez vous me donner des idées comment je pourrais faire ceci en VBA:
--> transposer un tableau sous forme de colonnes en un tableau sous forme de liste.

Voir mon exemple en pièce attaché (il s'agit d'un echantillon d'un plus grand jeu de données).
La feuille INPUT est ma source de données
La feuille OUTPUT est le résultat que j'aimerai avoir.

Hypothèses
1) Il peut y avoir plusieurs centaines d'IDs.
2) Chaque ID's possèdent différent Elements.
3) Pour chaque combinaisons de ID et de Element, nous avons un résultat par PERIODE (le nombre de périodes peut varier).

Merci de m'aider.

[geogeo70]

Bonsoir,

J'ai fait une transposition qui me semble répondre à votre problème; Pour être plus rapide je la fais par ligne id et element, si vous le voulez trié par periode il suffit de faire le tri correspondant.

voici mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Sub transposition()
 
Dim ligne As Integer, Period As Integer, Derperiod As Integer, Debid As Integer, Bas As Integer
 
Application.ScreenUpdating = False
Set ws = Sheets("INPUT")
Set dest = Sheets("resultat")
 
'dernière ligne
Bas = Cells(64000, 2).End(xlUp).Row
 
Debid = 2
ligne = 2
While Debid <= Bas
    'recherche première id
    While ws.Cells(Debid, 2) = "" And Debid <= Bas
        Debid = Debid + 1
    Wend
 
    'parcours des id's courantes
    While ws.Cells(Debid, 2) <> ""
        'traitement des id's
        Derperiod = ws.Cells(Debid, 10000).End(xlToLeft).Column
        Period = 5
        'parcours des périodes
        While Period <= Derperiod
            While ws.Cells(Debid, Period) = "" And Period <= Derperiod
                Period = Period + 1 'colonne suivante
            Wend
            If ws.Cells(Debid, Period) <> "" Then
                'traitement des périodes
                dest.Cells(ligne, 1) = ws.Cells(Debid, 2)
                dest.Cells(ligne, 2) = ws.Cells(Debid, 3)
                dest.Cells(ligne, 3) = ws.Cells(1, Period)
                dest.Cells(ligne, 4) = ws.Cells(Debid, Period)
 
                Period = Period + 1
            End If
            ligne = ligne + 1 'ligne suivante
        Wend
 
        Debid = Debid + 1 'id suivante
    Wend
Wend
Application.ScreenUpdating = True
End Sub

le fichier :TRANSPOSE DATA.xlsm

Merci de valider mon message s'il convient

Salutations les meilleures

[apnw7931]

Bonjour geogeo70,

Merci pour votre aide.
J'ai également travaillé cette nuit et suis arrivé à quelque chose de semblable à votre code.
Le votre à l'air plus rapide que le mien sur l'échantillon donné.

Par contre, je suis amené à traiter quelques millions de données/lignes dans ma feuille INPUT.
Dès lors, je m'inquiète de la performance du code proposé (avec des boucles for ou while).
Je dois tester ce matin au bureau.

Sinon, est ce que l'idée de faire des couper/coller (Cut & paste) ne serait pas moins gourmande en temps et ressource, plutot que de traiter ligne par ligne..
Une idée que je viens d'avoir.. encore faut-il trouver une logique.

Encore merci pour le travail fait jusqu'a présent, et pour la suite des solutions.

EDIT: J'arrive très proche des 1 048 576 lignes maximales de mon fichier excel...
EDIT: Ne serait-il pas possible de traiter l'information dans un fichier TEXTE (.txt)?
EDIT: Car la finalité serait d'exporter ma table/feuille RESULTAT dans une table ACCESS.

apnw7931

[patricktoulon]

Bonjour
prend ton fichier exemple et teste ca
cette macro fait ce que tu demande dans un fichier texte sauvé au même endroit ou se trouve le classeur
si tu veux un csv tu remplace l'espace dans la constante et change l'extension "txt" pour "csv" dans la ligne du output

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub transposition_to_fich_texte()
  Dim texte As String, col As Variant, i, cl, lig
    Const E = " "
    With Sheets(1)
        'récupération des colonnes a exploiter
        For i = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
            If .Cells(1, i) <> "" Then col = col & .Cells(1, i).Column & " "
        Next
        col = Split(Trim(col), " ")
        For cl = 0 To UBound(col)
            For lig = 1 To .Cells(Rows.Count, Val(col(cl))).End(xlUp).Row
                If .Cells(lig, Val(col(cl))) <> "" And IsNumeric(.Cells(lig, Val(col(cl)))) Then
                    texte = texte & E & .Cells(lig, 1) & E & .Cells(lig, 2) & E & .Cells(1, Val(col(cl))) & E & .Cells(lig, Val(col(cl))) & vbCrLf
                End If
            Next
        Next
    End With
    Debug.Print texte
    fichier = ThisWorkbook.Path & "\" & "transposition .txt"
    x = FreeFile
    Open fichier For Output As #x
    Print #x, texte
    Close #x
End Sub

voila

[geogeo70]

Bonjour,
Patrick donne un bon moyen de transformer en txt. Merci à lui, une remarque il faudra traiter les espaces dans les données car cela va multiplier les champs dans la base...

Bonne continuation

[patricktoulon]

Bonjour,
Patrick donne un bon moyen de transformer en txt. Merci à lui, une remarque il faudra traiter les espaces dans les données car cela va multiplier les champs dans la base...

Bonne continuation

re
c'est pour cela que j'ai mis une constante remplacer l'espace par ce que l'on veut
voila

[geogeo70]

J'ai intégré dans mon code la proposition de patrick (en utilisant ; comme séparateur de champ) et ouvert le fichier dans access, ça semble bien fonctionner. Voir quelle solution est plus rapide...

à vous!


mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Sub transposition()
 
Dim ligne As Integer, Period As Integer, Derperiod As Integer, Debid As Integer, Bas As Integer
Dim texte As String, E As String
 
 
Application.ScreenUpdating = False
Set ws = Sheets("INPUT")
Set dest = Sheets("resultat")
 
'dernière ligne
Bas = Cells(64000, 2).End(xlUp).Row
 
Debid = 2
ligne = 2
texte = ""
E = ";"
While Debid <= Bas
    'recherche première id
    While ws.Cells(Debid, 2) = "" And Debid <= Bas
        Debid = Debid + 1
    Wend
 
    'parcours des id's courantes
    While ws.Cells(Debid, 2) <> ""
        'traitement des id's
        Derperiod = ws.Cells(Debid, 10000).End(xlToLeft).Column
        Period = 5
        'parcours des périodes
        While Period <= Derperiod
            While ws.Cells(Debid, Period) = "" And Period <= Derperiod
                Period = Period + 1 'colonne suivante
            Wend
            If ws.Cells(Debid, Period) <> "" Then
                    texte = texte & ws.Cells(Debid, 2) & E & ws.Cells(Debid, 3) & E & ws.Cells(1, Period) & E & ws.Cells(Debid, Period) & vbCrLf
 
            'If ws.Cells(Debid, Period) <> "" Then
                'traitement des périodes
                'dest.Cells(ligne, 1) = ws.Cells(Debid, 2)
                'dest.Cells(ligne, 2) = ws.Cells(Debid, 3)
                'dest.Cells(ligne, 3) = ws.Cells(1, Period)
                'dest.Cells(ligne, 4) = ws.Cells(Debid, Period)
 
                Period = Period + 1
            End If
            ligne = ligne + 1 'ligne suivante
        Wend
 
        Debid = Debid + 1 'id suivante
    Wend
Wend
Debug.Print texte
fichier = ThisWorkbook.Path & "\" & "transposition .txt"
x = FreeFile
Open fichier For Output As #x
Print #x, texte
Close #x
Application.ScreenUpdating = True
 
End Sub