Transposition d'un tableau (VBA)

Version imprimable

1 pièce(s) jointe(s)

Bonjour,

Je tente de réaliser une transposition de tableau avec un code VBA que j'ai modifié mais le résultat n'est pas probant. En fait, la première colonne (N° unité) et la deuxième colonne (N° séjour) sont verticales et les valeurs (dates correspondant à la durée du séjour sont organisées horizontalement). L'objectif étant que toutes ces données soient en colonne. Je précise que ce tableau est très long (+12000 lignes) et que pour chaque ligne le nombre de colonnes disposant d'une valeur varient en fonction de la durée du séjour.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Sub Transpose() Sheets("TRANSPOSE").Cells.Clear With Sheets("SELECTION BD") NbCol = .Range("B1:" & .Range("IV1").End(xlToLeft).Address).Columns.Count For Each X In .Range("A2:" & .Range("A65536").End(xlUp).Address) LigDest = Sheets("TRANSPOSE").Range("A65536").End(xlUp).Offset(1, 0).Row For Each Y In X.Offset(0, 1).Resize(1, NbCol) Sheets("TRANSPOSE").Cells(LigDest, 1) = X Sheets("TRANSPOSE").Cells(LigDest, 2) = Y LigDest = Sheets("TRANSPOSE").Range("A65536").End(xlUp).Offset(1, 0).Row Next Next End With End Sub
Pièce jointe 322576

26/10/2017, 15h41
morgan75

Complément d'information

Bonjour,

Sur l'image que j'ai envoyé la source et le résultat (tableau en colonnes) sont sur la même feuille pour simplifier. En fait, ces tableaux sont sur des feuilles différentes. Le code que je vous ai présenté a comme inconvénient également de ne pas conserver les entêtes des colonnes.

En vous remerciant.

M
26/10/2017, 18h26
Marc-L

Bonjour,

alors présenter un code en rapport avec le fichier de travail réel …

S'intéresser par exemple à la propriété End permettant de trouver la dernière cellule d'une ligne
comme documentée dans l'aide VBA interne sans compter dans les discussions du bon forum,
ici étant celui des formules de calculs d'Excel et non celui dédié au VBA ! (edit : sujet déplacé dans le bon forum depuis …)

___________________________________________________________________________________________________________
Je suis Paris, Mogadicio, Barcelone, London, Manchester, Egypte, Stockholm, Istanbul, Berlin, Nice, Bruxelles, Charlie, …
26/10/2017, 18h58
unparia

Bonjour

J'utiliserais personnellement le tremplin d'un tableau
J'en connais le nombre de colonnes (trois)
J'en connais également le nombre de liges : -->> derlig étant la dernière cellule remplie de la colonne A - 1 (because entête), le nombre de lignes de ce tableau devra donc être du genre (à main levée) :

Code:

derlig + range("D2:X" & derlig).specialcells(xlcelltypeconstants).cells.count

Je traiterais ensuite de bas en haut avec une boucle for ... to ... Next Step -1
puis injecterais mon tableau où je le souhaite

PS : nous ne sommes pas ici dans la section VBA ...
26/10/2017, 19h46
morgan75

Bonsoir et merci,

Je n'avais pas connaissance de cette réorganisation du forum Excel. Excusez moi.
Quelqu'un pourrait basculer cette discussion sur la bonne rubrique, svp.

En vous remerciant,

M

Bon
Tu es en effet nouveau et donc excusable. Mais fais s'il te plait dorénavant le choix de la section adéquate.

Il semble que ce soit la semaine des calculs arithmétiques et je vais donc t'y inviter -->>
Il y a dans ce qui suit SURTOUT de l'arithmétique --->>
Exemple avec des données commençant à la ligne 2, colonne A de Feuil1 et à "transposer" à partir de la ligne 2, colonne A de Feuil2 --->> CommandButton1 sur Feuil1 --->>
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 Private Sub CommandButton1_Click() derlig = Range("A" & Rows.Count).End(xlUp).Row dercol = UsedRange.SpecialCells(xlCellTypeLastCell).Column nblig = derlig - 1 + Range(Cells(2, 4), Cells(derlig, dercol)).SpecialCells(xlCellTypeConstants).Cells.Count nbcol = 3 ReDim tablo(1 To nblig, 1 To nbcol) ou = 1 For k = 2 To derlig For j = 1 To Rows(k).SpecialCells(xlCellTypeConstants).Cells.Count - 2 tablo(ou, 1) = Cells(k, 1) tablo(ou, 2) = Cells(k, 2) tablo(ou, 3) = Cells(k, j + 2) ou = ou + 1 Next Next Worksheets("Feuil2").Range("A2:C" & ou).Value = tablo End Sub
Tu aimes l'arithmétique ? :lol: *******

******* : si pas des masses ou que cela te donne le tournis --->> intéresse-toi à la méthode worksheetfunction.transpose, appliquée en boucle au contenu, pour chaque ligne, des cellules remplies à partir de la 3ème colonne :idea:

27/10/2017, 10h58
morgan75

Bonjour,

Un très grand merci Unparia, la procédure fonctionne parfaitement, même si j'ai toujours quelques difficultés à la comprendre mais je doute que l'arithmétique soit vraiment en cause :)
Mon problème est que je ne vois pas comment faire pour exécuter une private sub qui est dans ma feuille ("SELECTION BD") avec un bouton (cette procédure s'inscrit en fait dans une série de procédures actionnées par un bouton), et je n'arrive pas à appeler cette procédure avec Call.

M
27/10/2017, 12h01
unparia

Citation:

cette procédure s'inscrit en fait dans une série de procédures actionnées par un bouton), et je n'arrive pas à appeler cette procédure avec Call

Montre ce que tu as écrit (déclaration incluse) dans le code de ce bouton ...

1 pièce(s) jointe(s)

Pièce jointe 322766

Seule la procédure toutes les dates 2 contient une étape de déclaration des variables

Code:

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
Sub ToutesLesDates_2()
 
 
Sheets("BO JOURNEES").Select
 
If Range("I1") <> "" Then Exit Sub
 
'déclaration des variables
    Dim l As Integer 'variable pour gérer les lignes du tableau
    Dim c As Integer 'variable pour gérer les colonnes où vont s'ecrire les dates
    Dim debut As Date 'variable pour stocker la date de début de la ligne en cours de traitement
    Dim fin As Date  'variable pour stocker la date de fin de la ligne en cours de traitement
    Dim nouveau As Date 'variable pour stocker la nouvelle date à mettre dans les colonnes à coté
 
    'variable pour gérer les lignes. début du tableau en ligne 2
    l = 2
 
    'boucle pour aller jusqu'à la fin du tableau
    Do Until Cells(l, 7).Value = ""
        'on mémorise les dates de début et de fin
        debut = Cells(l, 7).Value
        fin = Cells(l, 8).Value
 
        'variable pour gérer la colonne à traiter pour nouvelle date à coté. 13 = col M
        c = 9
        'on défini la date à afficher dans la 1ere colonne
        nouveau = debut
        'boucle pour remplir la ligne avec les dates
        Do While nouveau <= fin
            'mise en plae de la date dasn la bonne lign et bonne colonne
            Cells(l, c).Value = nouveau
            'on ajoute 1 à la nouvelle date
            nouveau = nouveau + 1
            'on passe à la colonne suivante
            c = c + 1
        Loop
        'quand la ligne est remplie, on passe à la ligne suivante
        l = l + 1
    Loop
End Sub

L'étape avec la procédure Appel_PrivateSubTRANSPOSE_6 devait m'appeler ta procédure PRIVATE SUB

J'espère avoir pu répondre à ta question...

Et où est la difficulté ? Il te suffit d'appeler la procédure qui contient les instructions de transposition !
Tiens, je vais aller plus loin, en la paramétrant, de sorte à la rendre plus souple --->>
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 Private Sub Appel_PrivateSubTRANSPOSE_6(Forig As Worksheet, ligorig As Integer, colorig As Integer, Fdest As Worksheet, ligdest As Integer, coldest As Integer) With Forig derlig = .Cells(Rows.Count, colorig).End(xlUp).Row dercol = .UsedRange.SpecialCells(xlCellTypeLastCell).Column nblig = derlig - 0 + .Range(.Cells(ligorig, 4), .Cells(derlig, dercol)).SpecialCells(xlCellTypeConstants).Cells.Count nbcol = 3 ReDim tablo(1 To nblig, 1 To nbcol) ou = 1 For k = ligorig To derlig For j = 1 To .Rows(k).SpecialCells(xlCellTypeConstants).Cells.Count - 2 tablo(ou, 1) = .Cells(k, colorig) tablo(ou, 2) = .Cells(k, colorig + 1) tablo(ou, 3) = .Cells(k, colorig + j + 1) ou = ou + 1 Next Next End With With Fdest .Range(.Cells(ligdest, coldest), .Cells(UBound(tablo, 1), coldest + 2)).Value = tablo End With End Sub
et dans ton bouton : son appel, ainsi, avec les paramètres de ton choix -->> ici (par exemple) -->>

Code:

Appel_PrivateSubTRANSPOSE_6 Worksheets("Feuil10"), 4, 3, Worksheets("Feuil9"), 6, 4

transposera en feuil9, à partir de la ligne 6 de la colonne 4 (donc colonne D), tes données présentes sur la feuil10 à partir de la ligne 4 de la colonne 3 (donc colonne C)
(étant entendu que les données à traiter sont bien présentes comme tu l'as montré dans ton image et qu'elles doivent bien être réparties sur 3 colonnes, comme tu l'as également montré).

02/11/2017, 16h49
morgan75

2 pièce(s) jointe(s)

Bonjour Unparia,

Mes tentatives pour appeler ta procédure se sont avérées vaines .
J'ai tout d'abord placé ton script Private Sub Appel_PrivateSubTRANSPOSE_6 du 27/10/2017 , comme pour la fois précédente, dans la feuille SELECTION BD (feuille de provenance) et j'ai renommé dans le bouton l'étape 6 d'appel comme suit:

Code:

Appel_PrivateSubTRANSPOSE_6 Worksheets("SELECTION BD"), 1, 1, Worksheets("TRANSPOSE"), 1, 1

J'ai obtenu le message d'erreur suivant:

Pièce jointe 324258

Devant cet echec, je me suis dit que j'avais peut être mal interprété tes propos et que le code

Code:

Appel_PrivateSubTRANSPOSE_6 Worksheets("SELECTION BD"), 1, 1, Worksheets("TRANSPOSE"), 1, 1

devait être intégré dans la procédure d'appel et c'est ce que j'ai fait mais là encore j'ai essuyé un echec:

Pièce jointe 324266

J'ai conscience que tu m'as maché le travail,ca se joue peut être à un point virgule, mais je ne trouve pas le moyen d'appeler cette Private sub.

M