XL 2016 transformation de tableau par macro simple

[eastwick]

Bonjour à toutes et tous,
Ci-joint un petit fichier qui vous explique ma requête.
Il s'agit de transformer un tableau en un autre, ce dernier ne conserve que les libellés "budget" une seule fois en tête de colonne.
Vous comprendrez mieux en ouvrant le fichier.
Je vous remercie.

 

[Dranreb]

Bonjour.

Option Explicit
Sub Test()
   Dim TDon(), TRésu(), LD As Long, C As Integer, LR As Long
   TDon = ActiveSheet.[A1].CurrentRegion.Value
   ReDim TRésu(1 To 5, 1 To UBound(TDon, 1))
   LD = 1
   Do: C = C + 1: LR = 1: TRésu(LR, C) = TDon(LD, 1)
      Do:
         LR = LR + 1: TRésu(LR, C) = TDon(LD, 2)
         If LD >= UBound(TDon, 1) Then Exit Do
         LD = LD + 1
         Loop Until TDon(LD, 1) <> TRésu(1, C)
      Loop Until LD = UBound(TDon, 1)
   [D1].Resize(5, C).Value = TRésu
   End Sub

 

[eastwick]

Bonjour Dranreb, ça ne fonctionne pas...

 

[Dranreb]

Essayez en supprimant les lignes 28 à 32, il semble qu'elles ne soient pas complètement vides.

 

[vgendron]

Hello le fil

un essai par macro avec dico

Sub tabtotab()

Dim TabData() As Variant
Set dico = CreateObject("scripting.dictionary")

With ActiveSheet
    LastLine = .Range("A" & .Rows.Count).End(xlUp).Row
    TabData = .Range("A1:B" & LastLine).Value
    
    For i = LBound(TabData, 1) To UBound(TabData, 1)
        
        clé = TabData(i, 1)
        Valeur = TabData(i, 2)
        If Not dico.exists(clé) Then
            dico.Add clé, Valeur
        Else
            dico(clé) = dico(clé) & "," & Valeur
        End If
    
    Next i
    
    i = 4
    For Each clé In dico.keys
        .Cells(1, i) = clé
        tablo = Split(dico(clé), ",")
        .Cells(2, i).Resize(UBound(tablo) + 1) = WorksheetFunction.Transpose(tablo)
        i = i + 1
    Next clé
End With
End Sub

 

[vgendron]

sinon, je pense que Power Query sait faire ca en un rien de temps (dépivoter colonnes).

 

[Dranreb]

Avec ma fonction Gigogne c'est possible aussi et presque plus simple que sans :

Sub Test2()
   Dim TRésu(), SGrBudg As SsGr, C As Integer, LR As Integer, Détail
   ReDim TRésu(1 To 5, 1 To 500)
   For Each SGrBudg In Gigogne(Feuil1.[A1].CurrentRegion, 1)
      C = C + 1: TRésu(1, C) = SGrBudg.Id
      LR = 1
      For Each Détail In SGrBudg.Co
         LR = LR + 1: TRésu(LR, C) = Détail(2)
         Next Détail, SGrBudg
   [D7].Resize(5, C).Value = TRésu
   End Sub

Les colonnes sont alors classées sur les budgets.

 

[eastwick]

Merci à tous les 2, je vais me débrouiller avec ça, ça devrait aller

 

[Cousinhub]

Bonjour,

sinon, je pense que Power Query sait faire ca en un rien de temps (dépivoter colonnes).

Bonjour Vincent,
Un (tout petit) peu plus complexe que le simple dépivotage, hélas...
Le code qui le fait (Power Query)

let
    Source = Excel.CurrentWorkbook(){[Name="Tableau1"]}[Content],
    Filtr = Table.SelectRows(Source, each ([Colonne1] <> "")),
    GroupBy = Table.Group(Filtr, {"Colonne1"}, {{"Budget", each _[Colonne2]}}),
    Final = Table.FromColumns( GroupBy[Budget], GroupBy[Colonne1])
in
    Final

Le fichier :