XL 2013 Transposer valeurs via dictionary

[erics83]

Bonjour,

je cherche à transposer des valeurs d'un tableau, pour une utilisation plus "facile" et pertinente par un TCD....
en gros, j'ai des colonnes avec les mois, et j'aimerai reprendre les les valeurs et les mettre en ligne...

J'ai vu le tuto de JB () où on pourrait transposer en utilisant dictionary...

Je mets un classeur test avec exemple....

Merci pour votre aide,

 

[patricktoulon]

Bonjour
regarde ce que je fait

valider par CTRL+ MAJ+ENTER pour les version antérieures a 365

 

[sylvanu]

Bonjour Eric, Patrick,
Sauf si vous voulez impérativement utiliser un dictionnary, on peut le faire simplement avec :

Sub Transposition()
    Range("U2:V13") = Application.Transpose(Range("D1:O2"))
End Sub

 

[patricktoulon]

re
Bonjour @sylvanu même pas besoins de vba

 

[sylvanu]

Re,
Tout dépend du contexte désiré par l'utilisateur. VBA déjà présent, manip récurrente ...
Maintenant il peut choisir.

 

[sylvanu]

Re,
Mais c'est exactement la même structure :

Sub Transposition()
    Range("A1:ARI29") = Application.Transpose(Sheets("SISP2").Range("A1:AC1153"))
End Sub

 

[erics83]

Merci sylvanu,

Mais j'ai mal exprimé mon besoin : en fait, ce n'est que les mois qu'il faudrait transposer : un peu comme si on faisait la manipulation de Patricktoulon pour chaque ligne..... je mets le fichier test pour que ce soit plus explicite....d'où l'idée initiale de passer par Dictionary...
le but étant de pouvoir réaliser par la suite, des TCD "facilement" ....

Merci pour votre aide, et MERCI

 

[sylvanu]

Re,
Vous devriez apprendre à spécifier. On y gagnerait beaucoup de temps.
N'étant pas à l'aise avec les dictionnary, je suis passé par des arrays.
En PJ un Nième essai. J'ai supposé que les lignes remplies de tirets ne devait pas être pris en compte.

    Dim DL%, T, T2, Mois, i%, j%, k%, NbTirets%, Chaine$, IndexT2%, Index%, NbPlages, Ligne%
    Application.ScreenUpdating = False
    [A:E].ClearContents: [A:E].Interior.Color = vbWhite     ' Efface données précédentes
    DL = Sheets("Données").Range("A65500").End(xlUp).Row    ' Dernière ligne utile
    T = Sheets("Données").Range("A2:O" & DL)                ' Tranfert données dans array
    Mois = Sheets("Données").Range("D1:O1")                 ' Tranfert mois dans array
    ReDim T2(12 * DL, 5): IndexT2 = 1                       ' T2 : array de sortie
    For i = 1 To UBound(T)
        NbTirets = 0                                ' Détection ligne vide qui contient 12 tirets
        For j = 4 To 15
            If T(i, j) = "-" Then NbTirets = NbTirets + 1
        Next j
        If NbTirets < 12 Then                       ' Si pas ligne vide
            For k = 0 To 11
                T2(IndexT2 + k, 1) = T(i, 1)        ' Ville
                T2(IndexT2 + k, 2) = T(i, 2)        ' Indice
                T2(IndexT2 + k, 3) = T(i, 3)        ' Libellé
                T2(IndexT2 + k, 4) = Mois(1, k + 1) ' Mois
                T2(IndexT2 + k, 5) = T(i, k + 4)    ' Valeur
            Next k
            IndexT2 = IndexT2 + 12                  ' Incrément index stockage ( page de 12 éléments )
        End If
    Next i
    Range("$A$1").Resize(UBound(T2, 1), UBound(T2, 2)) = T2         ' Rangement données dans feuilles
    NbPlages = Round(0.1 + Range("A65500").End(xlUp).Row / 24, 0)   ' Mise en couleur par plage de 12 mois
    Ligne = 1
    For k = 1 To NbPlages
        Range(Cells(Ligne, "A"), Cells(Ligne + 11, "E")).Interior.Color = RGB(255, 255, 200)
        Range(Cells(Ligne + 12, "A"), Cells(Ligne + 24, "E")).Interior.Color = RGB(220, 255, 255)
        Ligne = Ligne + 24
    Next k
End Sub

 

[Hasco]

Bonjour,

Dans le fichier joint une solution par power query Téléchargeable gratuitement en tant que complément pour excel 2013 ( il fait partie d'excel seulement à partir de la version 2016)

Download Power Query from Official Microsoft Download Center

Microsoft Power Query pour Excel est un complément Excel qui améliore l'expérience du décisionnel libre-service dans Excel en simplifiant la récupération des données, l'accès et la collaboration.

www.microsoft.com

La requête ici transpose tout le tableau ce qui donne 2148 lignes ( un filtre serait possible), la création de date également (manquent les années)

pour une utilisation plus "facile" et pertinente par un TCD....

Pour que vos données soient pertinentes pour un TCD il serait préférable que la colonne Valeurs contiennent des données de même type. Ici vous avez du texte (ex : 35jrs) des entiers, des pourcentages. Peut être en trois colonnes suivant le type et la nature de la valeur

Au vu de vos données, l'information donnant la nature de la colonne Valeur serait la colonne Libellé.


Cordialement

 

[erics83]

Merci Hasco,

Je suis dans un environnement qui ne me permet pas de télécharger, mais j'ai bien compris ...et merci pour la remarque concernant les années, car effectivement elle manque....

MERCI sylvanu,
Merci pour les explications qui me permettent de comprendre le code et la logique, et c'est vrai que passer par des arrays est plus simple que Dictionary (que je ne "domine" pas trop non plus....)...et....il fonctionne parfaitement !! MERCI !!

Merci pour votre aide,

 

[job75]

Bonsoir à tous,

Pourquoi parler de Dictionary puisqu'il ne s'agit que de copies et de transpositions ?

Si le tableau n'est pas trop grand on peut travailler directement sur les cellules, c'est plus simple :

Sub Transposer()
Dim derlig&, mois, lig&, r As Range, test As Boolean, rr As Range, x$
With Sheets("Feuil1") 'à adapter
    derlig = .Cells.SpecialCells(xlCellTypeLastCell).Row
    If derlig = 1 Then Exit Sub
    mois = Application.Transpose(.[D1:O1])
    Application.ScreenUpdating = False
    .Range("R2:V" & derlig).Delete xlUp 'RAZ
    lig = 2 '1ère ligne de destination
    For Each r In .Range("D2:O" & derlig).Rows
        test = False
        For Each rr In r.Cells
            x = Replace(Replace(rr, "-", ""), " ", "")
            If x <> "" Then test = True: Exit For
        Next rr
        If test Then
            .Cells(lig, "R").Resize(12) = r.Cells(1, -2)
            .Cells(lig, "S").Resize(12) = r.Cells(1, -1)
            .Cells(lig, "T").Resize(12) = r.Cells(1, 0)
            .Cells(lig, "U").Resize(12) = mois
            .Cells(lig, "V").Resize(12) = Application.Transpose(r)
            lig = lig + 12
        End If
    Next r
    .[V:V].Replace ",", ".", xlPart 'convertit les textes en nombres
End With
End Sub

Pour tester j'ai copié la plage A2:O181 sur 9000 lignes.

Chez moi la macro s'exécute en 2,7 secondes, c'est acceptable.

Bonne nuit.

 

[erics83]

Bonjour et MERCI Job75,

Effectivement, je focalisais sur Dictionary, mais...là, c'est très rapide aussi.....Merci

Merci pour votre aide,
Eric

 

[job75]

Bonjour erics83, le forum,

Si l'on veut une coloration alternée utiliser une MFC sur les colonnes R:V :

=($R1<>"")*MOD(1+ENT((LIGNE()-2)/12);2)

A+