XL 2013 Transposer valeurs via dictionary

erics83

XLDnaute Impliqué
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,
 

Pièces jointes

  • Classertesttransposé.xlsx
    55.4 KB · Affichages: 10

patricktoulon

XLDnaute Barbatruc
Bonjour
regarde ce que je fait
demo2.gif


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

erics83

XLDnaute Impliqué
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
 

Pièces jointes

  • Classertesttransposé.xlsx
    56.2 KB · Affichages: 8

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
Vous devriez apprendre à spécifier. On y gagnerait beaucoup de temps. :eek:
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.
VB:
    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
 

Pièces jointes

  • Classertesttransposé (1).xlsm
    119.1 KB · Affichages: 5

Hasco

XLDnaute Barbatruc
Repose en paix
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)

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
 

Pièces jointes

  • Classertesttransposé.xlsx
    128.3 KB · Affichages: 2
Dernière édition:

erics83

XLDnaute Impliqué
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

XLDnaute Barbatruc
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 :
VB:
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.
 

Pièces jointes

  • Classertesttransposé(1).xlsm
    64.9 KB · Affichages: 7

Discussions similaires

Statistiques des forums

Discussions
312 923
Messages
2 093 665
Membres
105 780
dernier inscrit
Autric