XL 2019 Transformation d'un tableau de ligne en colonne

[foufa]

Bonjour à tous,

J'ai un fichier excel avec différents formateurs qui ont dispensé plusieurs formations et de durées différentes également. Mon fichier actuellement est en ligne donc un formateur peut avoir plusieurs lignes.
Je souhaite transformer le fichier de façon à ce que j'ai qu'une ligne par formateur et que les formations et les jours soient sur la même ligne (en colonne ).
ça ne marche pas en tcd et même sur power BI je n'ai pas vraiment su. si vous avez une solution sous excel pour power bi je suis preneuse
Fichier joint.
En vous remerciant pour votre aide.
Cordialement

 

[Hasco]

Bonjour,

Un proposition par power query, mais il faudra mettre la main à la pâte.
Voir chaque étape dans la barre de formule à partir de l'étape "Indexation"
Si le nombre de formation peut être supérieur à 5 on peut éventuellement créer une fonction qui nommera les colonnes automatiquement dans la dernières étape

La requête suivante, développe les colonnes quelque soit leur nombre et et type les colonnes de durée

let
    Source = Excel.CurrentWorkbook(){[Name="T_Formations"]}[Content],
    #"Type modifié" = Table.TransformColumnTypes(Source,{{"Formateur", type text}, {"Libellé formation", type text}, {"Nbr jours", type number}}),
    #"Colonnes fusionnées" = Table.CombineColumns(Table.TransformColumnTypes(#"Type modifié", {{"Nbr jours", type text}}, "fr-FR"),{"Libellé formation", "Nbr jours"},Combiner.CombineTextByDelimiter(";", QuoteStyle.None),"Fusionné"),
    #"Lignes groupées" = Table.Group(#"Colonnes fusionnées", {"Formateur"}, {{"Datas", each _, type table [Formateur=nullable text, Fusionné=text]}}),
    Indexation  = Table.TransformColumns (#"Lignes groupées", {"Datas", each Table.AddIndexColumn(_,"idx",1)}),
    Pivotement  = Table.TransformColumns( Indexation, {"Datas", each Table.Pivot(Table.TransformColumnTypes(_, {{"idx", type text}}, "fr-FR"), List.Distinct(Table.TransformColumnTypes(_, {{"idx", type text}}, "fr-FR")[idx]), "idx", "Fusionné")} ),
    Eclatement =  Table.TransformColumns( Pivotement,{"Datas",each List.Accumulate(List.Skip(Table.ColumnNames( _),1), _, (LaTable,idx) => Table.SplitColumn(LaTable,idx, Splitter.SplitTextByDelimiter(";", QuoteStyle.Csv),{"Formation "& idx, "Durée " &idx }))}),
    #"Liste Noms Colonnes" = List.Combine( List.Transform( List.Numbers(1, List.Max( List.Transform(Pivotement[Datas], each Table.ColumnCount(_)-1))), each { "Formation " & Text.From(_), "Durée " & Text.From(_) })),
    #"Colonne développées" = Table.ExpandTableColumn(Eclatement, "Datas",  #"Liste Noms Colonnes"),
    #"Durées typées" = Table.TransformColumnTypes(#"Colonne développées",List.Transform( List.Alternate(#"Liste Noms Colonnes",1,1), each {_,type number}))
in
    #"Durées typées"

Cordialement

 

[chris]

Bonjour

Une solution PowerQuery après mise sous forme de tableau structuré du tableau source
Actualiser par clic droit ou Données, Actualiser Tout

 

[job75]

Bonsoir foufa, Hasco, chris,

Voyez le fichier .xlsm joint et cette macro dans le code de la feuille "Résultat" :

Private Sub Worksheet_Activate()
Dim tablo, resu(), d As Object, i&, x$, nn&, n&, P As Range, j%
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
Cells.Delete 'RAE
tablo = Sheets("Feuil1").[D4].CurrentRegion.Resize(, 3) 'matrice, plus rapide
ReDim resu(1 To UBound(tablo), 1 To 2)
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
    x = tablo(i, 1)
    If d.exists(x) Then
        nn = d(x) 'récupère la ligne
        resu(nn, 2) = resu(nn, 2) & Chr(1) & tablo(i, 2) & Chr(1) & tablo(i, 3)
    Else
        n = n + 1
        d(x) = n 'mémorise la ligne
        resu(n, 1) = x
        resu(n, 2) = tablo(i, 2) & Chr(1) & tablo(i, 3)
    End If
Next i
If n = 0 Then Exit Sub
'---restitution---
[A2].Resize(n, 2) = resu
[B2].Resize(n).TextToColumns [B2], xlDelimited, Other:=True, OtherChar:=Chr(1) 'commande Convertir
[A1] = "Formateur"
Set P = UsedRange
Set P = P.Resize(, 1 + 2 * Int(P.Columns.Count / 2)) 'nombre impair de colonnes
For i = 2 To P.Columns.Count Step 2
    j = j + 1
    P(1, i) = "Formation  " & j
    P(1, i + 1) = "Durée  " & j
Next i
P.Borders.Weight = xlThin 'bordures
P.Columns.AutoFit 'ajustement largeurs
End Sub

Elle se déclenche automatiquement quand on active la feuille.

Edit : Set P = UsedRange au lieu de [A1].CurrentRegion

A+

 

[mapomme]

Bonsoir,

Juste pour le fun, moins rapide que la macro de @job75 mais sans dictionary.
La macro se déclenche automatiquement quand on active la feuille.

Le code:

Private Sub Worksheet_Activate()
Dim t, i&, n&, j&
   ' Préparation
   Application.ScreenUpdating = False
   Cells.Delete
   If FilterMode Then ShowAllData
   t = Sheets("Feuil1").[D4].CurrentRegion.Resize(, 3)
   ' Construction du tableau résultat
   Range("a1") = "Formateurs"
   For i = 2 To UBound(t)
      n = Application.IfError(Application.Match(t(i, 1), Columns(1), 0), 0)
      If n = 0 Then n = Cells(Rows.Count, "a").End(xlUp).Row + 1: Cells(n, "a") = t(i, 1)
      j = Cells(n, Columns.Count).End(xlToLeft).Column + 1
      Cells(n, j) = t(i, 2): Cells(n, j + 1) = t(i, 3)
   Next i
   ' Mise en forme du tableau résultat
   With Range("a1").CurrentRegion
      For j = 2 To .Columns.Count Step 2
         Cells(1, j) = "Libellé " & (j / 2)
         Cells(1, j + 1) = "Durée " & (j / 2)
      Next j
      With Me.ListObjects.Add(xlSrcRange, .Cells, , xlYes)
         .TableStyle = "TableStyleMedium9": .Unlist
      End With
   End With
End Sub

 

[job75]

Bonjour mapomme, le forum,

Pour le fun, dans le tableau source, efface les cellules F7 F8 F12.

A+

 

[Dranreb]

Bonjour
J'y vais de la mienne aussi, alors :

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim T(), Formateur As SsGr, L&, C&, Détail
   If Target.Column > 4 Then Exit Sub
   ReDim T(1 To 100, 1 To 9)
   For Each Formateur In Gigogne([D5:F5], 1)
      L = L + 1
      T(L, 1) = Formateur.Id
      C = 0
      For Each Détail In Formateur.Co
         C = C + 2
         T(L, C) = Détail(2)
         T(L, C + 1) = Détail(3)
         Next Détail, Formateur
   Application.EnableEvents = False
   [K6].Resize(100, 9).Value = T
   Application.EnableEvents = True
   End Sub

 

[Dranreb]

Avec peu de changements on peut le transformer en tableau à deux entrées :

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Dic As Dictionary, T(), Formateur As SsGr, L&, Détail
   If Target.Column > 4 Then Exit Sub
   ReDim T(1 To 100, 1 To 9)
   T(1, 1) = "Formateur"
   Set Dic = DicInvent([D5:F5], 2, 2)
   VerserEntêtes T, Dic, 2
   L = 1
   For Each Formateur In Gigogne([D5:F5], 1)
      L = L + 1
      T(L, 1) = Formateur.Id
      For Each Détail In Formateur.Co
         T(L, Dic(Détail(2))) = Détail(3)
         Next Détail, Formateur
   Application.EnableEvents = False
   [K5].Resize(100, 9).Value = T
   Application.EnableEvents = True
   End Sub

 

[mapomme]

Bonjour @job75 , @Dranreb ,

Pour le fun, dans le tableau source, efface les cellules F7 F8 F12.

Vous trouvez ça drôle Monsieur, et à 7h06 du matin en plus !
La version v2 qui corrige l'anomalie.

Très Bonne journée à tous .

 

[job75]

Bonjour Bernard,

Un tableau à double entrée est effectivement une bonne solution, voyez ce fichier (2) et la macro :

Private Sub Worksheet_Activate()
Dim tablo, d1 As Object, d2 As Object, d3 As Object, i&, x$, y$, ub%, j%
tablo = Sheets("Feuil1").[D4].CurrentRegion.Resize(, 3) 'matrice, plus rapide
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set d3 = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
    x = tablo(i, 1): y = tablo(i, 2)
    d1(x) = ""
    d2(y) = ""
    d3(x & Chr(1) & y) = tablo(i, 3) 'mémorise le nombre de jours
Next i
'---restitution des en-têtes---
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
Cells.Delete 'RAZ
If d1.Count Then
    [A1] = "Formateur"
    [A2].Resize(d1.Count) = Application.Transpose(d1.keys)
End If
If d2.Count Then [B1].Resize(, d2.Count) = d2.keys
'---remplissage du tableau des résultats---
With UsedRange
    tablo = .Value 'matrice, plus rapide
    If Not IsArray(tablo) Then Exit Sub 'tableau vide
    ub = UBound(tablo, 2)
    For i = 2 To UBound(tablo)
        For j = 2 To ub
            tablo(i, j) = d3(tablo(i, 1) & Chr(1) & tablo(1, j))
    Next j, i
    .Value = tablo 'restitution
    .Borders.Weight = xlThin 'bordures
    If ub > 1 Then .Columns(2).Resize(, ub - 1).HorizontalAlignment = xlCenter 'centrage facultatif
    .Columns.AutoFit 'ajustement largeurs
End With
End Sub

3 Dictionary sont utilisés.

 

[job75]

@mapomme note que tu peux remplacer :

If IsNumeric(t(i, 3)) And t(i, 3) <> "" Then Cells(n, j + 1) = t(i, 3) Else Cells(n, j + 1) = 0

par :

Cells(n, j + 1) = Val(Replace(t(i, 3), ",", "."))