Discussion :

[morgan75]

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 :

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

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

[morgan75]

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

[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, …

[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 :

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

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 ...

[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

[unparia]

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 :

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
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 ? *******

******* : 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

[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

[unparia]

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 ...

[morgan75]

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

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
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...

[unparia]

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 :

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
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 :

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

 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é).

[morgan75]

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 :

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

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

J'ai obtenu le message d'erreur suivant:



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

Code :

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

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:





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