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

[patricktoulon]

re
Geo tu n'améliore en rien la rapidité puisque tu boucle toujours sur les cells

comme je l'ai dis précédemment la seule façon d'accélérer le smilblick
c'est de le faire dans une variable tableaux de la même manière qu'avec les cells

[geogeo70]

Bonsoir,
En reprenant l'idée de Patrick, j'ai copié les données dans un tableau et les ai traitées en boucles dont voici le 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
Option Explicit 'pour redim
 
 
Sub transposition()
 
Dim Repertoire As String, Fichier As String
Dim Tableau() As Variant
Dim x As Integer, i As Integer
Dim VerifTab As Variant
 
Dim ligne As Integer, Period As Integer, Derperiod As Integer, Debid As Integer, Bas As Integer
Dim texte As String, E As String
Dim ws As Worksheet, dest As Worksheet
 
Application.ScreenUpdating = False
Set ws = Sheets("INPUT")
Set dest = Sheets("resultat")
 
'dimensions
Bas = ws.Cells(64000, 2).End(xlUp).Row
Derperiod = ws.Cells(1, 10000).End(xlToLeft).Column
 
ReDim Tableau(1 To Bas, 1 To Derperiod) 'tableau dimensionné
 
Tableau = ws.Range(Cells(1, 1), Cells(Bas, Derperiod)) 'copie dans le tableau
 
Debid = 2
 
texte = ""
E = ";"
 
While Debid <= Bas
    'parcours des id's courantes
    If Tableau(Debid, 2) <> "" Then
        'traitement des id's
        Derperiod = ws.Cells(Debid, 10000).End(xlToLeft).Column 'peut être à supprimer... mais parcours de toutes les periodes
        Period = 5
        'parcours des périodes
        While Period <= Derperiod
            If Tableau(Debid, Period) <> "" Then
                    texte = texte & Tableau(Debid, 2) & E & Tableau(Debid, 3) & E & Tableau(1, Period) & E & Tableau(Debid, Period) & vbCrLf
            End If
            Period = Period + 1 'colonne suivante
        Wend
    End If
    Debid = Debid + 1 'id suivante
Wend
'sauvegarde du texte
Fichier = ThisWorkbook.Path & "\" & "transposition .txt"
x = FreeFile
Open Fichier For Output As #x
Print #x, texte
Close #x
Application.ScreenUpdating = True
 
End Sub

Les essais sont-ils concluants ?

bonne soirée

geogeo

[patricktoulon]

oulahh geo!!!

Code :

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

1
2
ReDim Tableau(1 To Bas, 1 To Derperiod) 'tableau dimensionné 
Tableau = ws.Range(Cells(1, 1), Cells(Bas, Derperiod)) 'copie dans le tableau

tu peux me dire a quoi te sert de dimensionner un tableau si c'est pour dans la ligne suivante lui attribuer une plage
un exemple parmi tant d'autre

Code :

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

1
2
3
4
5
Sub test()
Dim tableau As Variant
tableau = Sheets(1).UsedRange.Value
MsgBox UBound(tableau)
End Sub

[apnw7931]

Bonjour patricktoulon et geogeo70,

Merci pour vos propositions !
Je devais trouver une solution rapidement hier (pour traiter au final plus de 6 millions de lignes).
Je me suis donc inspiré de vos propositions pour arriver au résultat escompté (à savoir que mon problème initial est plus complexe que celui dont je vous ai décris).
Donc merci beaucoup à vous deux.

J'essayerai d'améliorer mon code la semaine prochaine.
La, j'essaye de comprendre vos différentes idées avec l'utilisation d'un tableau et en quoi c'est plus efficace.. (versus traitement cellule par cellule)
Je regarde le forum pour un peu d'aide.

Belle journée à tout le monde !

[geogeo70]

oulahh geo!!!

tu peux me dire a quoi te sert de dimensionner un tableau si c'est pour dans la ligne suivante lui attribuer une plage
un exemple parmi tant d'autre

Mais c'est bien sûr.... J'en apprends tous les jours

c'est très interessant!

geogeo
P.S. :

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
Sub transposition()
 
Dim Repertoire As String, Fichier As String
Dim Tableau() As Variant
Dim x As Integer, i As Integer
 
Dim Period As Integer, Derperiod As Integer, Debid As Integer, Bas As Integer
Dim texte As String, E As String
Dim ws As Worksheet, dest As Worksheet
 
 
Set ws = Sheets("INPUT")
Set dest = Sheets("resultat")
 
'dimensions
Tableau = ws.UsedRange.Value
 
Bas = UBound(Tableau, 1)
Derperiod = UBound(Tableau, 2)
 
Debid = 2
 
texte = ""
E = ";"
 
While Debid <= Bas
    'parcours des id's courantes
    If Tableau(Debid, 2) <> "" Then
        'traitement des id's
        Derperiod = ws.Cells(Debid, 10000).End(xlToLeft).Column 'peut être à supprimer... mais parcours de toutes les periodes
        Period = 5
        'parcours des périodes
        While Period <= Derperiod
            If Tableau(Debid, Period) <> "" Then
                    texte = texte & Tableau(Debid, 2) & E & Tableau(Debid, 3) & E & Tableau(1, Period) & E & Tableau(Debid, Period) & vbCrLf
            End If
            Period = Period + 1 'colonne suivante
        Wend
    End If
    Debid = Debid + 1 'id suivante
Wend
 
'sauvegarde du texte
Fichier = ThisWorkbook.Path & "\" & "transposition .txt"
x = FreeFile
Open Fichier For Output As #x
Print #x, texte
Close #x
 
 
End Sub

[patricktoulon]

bonsoir Geo
pour cette ligne

Code :

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

Derperiod = ws.Cells(Debid, 10000).End(xlToLeft).Column 'peut être à supprimer... mais parcours de toutes les periodes

perso je ferait comme suit

Code :

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

Derperiod = ws.Cells(Debid, columns.count).End(xlToLeft).Column 'peut être à supprimer... mais parcours de toutes les periodes

et par rapport a l'exemple qu'a fourni le demandeur il te manque des test

le test( <>"") n'est pas suffisant , il te faut tester le (numérique ou pas) aussi car la ligne des titres se répète plusieurs fois