Recréer base de données à partir d'un tableau groupé

Bonjour !

Je bloque sur un sujet qui, j'en suis sûre, doit pouvoir se régler grâce à la magie d'excel! Mon niveau ne me permettant pas encore de m'en sortir toute seule, je jette une bouteille à la mer en espérant que quelqu'un ici aura une idée à me proposer.

Je reçois régulièrement des reporting extrait d'un logiciel comptable sous la forme d'un tableau groupé (plusieurs niveaux hiérarchique pour les clients). Je souhaiterais "décortiquer" le plan pour que chaque niveau apparaissent dans une colonne séparée afin de recréer la base de donnée originelle.

Je vous joint un exemple avec ce que je recois et ce que je cherche à obtenir.

Merci d'avance à tout ceux qui se pencheront sur le sujet !

Bonjour,

Pas sur que ce soit le résultat attendu, mais une approche assez simple via power query si vos "identifiants" de niveaux sont aussi simples que sur l'exemple (ie. tout un niveau commence par le meme mot).

Vous pouvez ensuite simplement filtrer les colonnes en décochant les cases vides.

Bonsoir à tous !

Une autre approche via Power Query (avec la contrainte précisée par saboh12617 concernant la convention de nommage de la hiérarchie) :

Bonjour saboh12617 & JFL !

Merci beaucoup pour vos réponses super rapides ! Malheureusement, ce serait trop beau si chaque niveau portait commençait par le même mot... Ils sont aux contraire tous très différents (sauf peut etre le niveau "canal" qui se répète de ville en ville). Vous pensez qu'il existe un autre moyen ?

Bonne journée,

Maggs

Bonjour à tous !

Si vous n'êtes pas en mesure de nous indiquer les marqueurs signifiants de début et fin de niveau, vous ne pourrez hélas espèrer, me semble-t-il, une solution opérationnelle.

Bonjour,

Oui effectivement comme l'indique JFL ça risque d'etre compliqué. J'ai regardé en VBA mais le problème est que ces "groupes" de cellules ne sont pas vraiment structurés…

Je viens de trouver une propriété, "outlinelevel", qui renvoie le petit numéro à gauche dans la liste. En supposant vos données bien ordonnées (cad. allant de 1 puis 1.1 puis 1.1.1, 1.1.2 etc.) alors je peux essayer de vous faire une macro. Mais beaucoup plus complexe effectivement. Et sans macro ca me semble impossible.

Bonjour,

Comme le disent mes éminents prédécesseurs, la seule solution pourrait passer par du code VBA.

Pour établir ce code, je suis parti sur la propriété IndentLevel de chaque cellule. Selon le retrait du texte dans chaque cellule, on peut déterminer son rang.

Ici, par exemple, la cellule B7, correspondant à "CLIENT 1" a un retrait de 5.

J'ai ensuite repris le code PQ fourni par JFL (pourquoi changer quelque chose de si bien fait), et adapté aux nouvelles données du Tableau (nommé tSource).

A la fin du code, je restitue le tableau à l'initial, après traitement par Power Query (il suffit de commenter l'avant-dernière ligne du code pour visualiser les modifications effectuées dans le tableau initial - après avoir fait une copie un peu plus loin, si on veut revenir)

Un clic sur le bouton GO, et c'est parti...

Sub mise_en_forme()
Dim I As Long
Dim TS As ListObject
Dim Tbl
Set TS = Range("tSource").ListObject
Tbl = TS.DataBodyRange
For I = 1 To TS.ListRows.Count
    With TS.DataBodyRange(I, 1)
        Select Case .IndentLevel
            Case 0
                .Value = "Mois@ : " & .Text
            Case 1
                .Value = "Ville@ : " & .Value
            Case 2
                .Value = "Quartier@ : " & .Value
            Case 3
                .Value = "Canal@ : " & .Value
            Case 5
                .Value = "Client@ : " & .Value
            Case 6
                .Value = "Produit@ : " & .Value
        End Select
    End With
Next I
Range("Résultat").ListObject.QueryTable.Refresh False
TS.DataBodyRange = Tbl
End Sub

Bonne journée

Edit :

Tout comme je l'ai fait pour le VBA, je rajoute le code M de la requête

let
    Source = Excel.CurrentWorkbook(){[Name="tSource"]}[Content],
    Record = Table.AddColumn(Source, "tbl", each
    [
        Mois = if Text.StartsWith([PRODUIT],"Mois@") then Text.AfterDelimiter([PRODUIT], "@ : ") else null, 
        VILLE= if Text.StartsWith([PRODUIT],"Ville@") then Text.AfterDelimiter([PRODUIT], "@ : ") else null, 
        QUARTIER = if Text.StartsWith([PRODUIT],"Quartier@") then Text.AfterDelimiter([PRODUIT], "@ : ") else null, 
        CANAL= if Text.StartsWith([PRODUIT],"Canal@") then Text.AfterDelimiter([PRODUIT], "@ : ") else null, 
        CLIENT=if Text.StartsWith([PRODUIT],"Client@") then Text.AfterDelimiter([PRODUIT], "@ : ") else null
    ]),
    Expand = Table.ExpandRecordColumn(Record, "tbl", {"Mois", "VILLE", "QUARTIER", "CANAL", "CLIENT"}),
    VersBas = Table.FillDown(Expand,{"Mois","VILLE", "QUARTIER", "CANAL", "CLIENT"}),
    Filtre = Table.SelectRows(VersBas, each try Text.StartsWith([PRODUIT],"Produit") otherwise false),
    ColReorder = Table.ReorderColumns(Filtre,{"Mois", "VILLE", "QUARTIER", "CANAL", "CLIENT", "PRODUIT", "QUANTITE"}),
    NettoyageProduit = Table.TransformColumns(ColReorder, {{"PRODUIT", each Text.AfterDelimiter(_, "@ : "), type text}})
in
    NettoyageProduit

Wow !!! Merci à vous trois, j'étais en train d'essayer de rajouter des codes identiques devant chaque niveau pour utiliser la méthode proposée mais la, avec la proposition de cousinhub ça a l'air de fonctionner !

J'ai plus qu'à essayer de comprendre comment ça marche pour éventuellement y arriver seule pus tard, mais pour aujourd'hui ça me résout tout !

Merci beaucoup beaucoup beaucoup !!

Très bonne journée à tous !

Bonjour,

A+

Bonjour à tous de nouveau !

@cousinhub :

Quelle contribution !

La créativité des contributeurs est un pur bonheur.

Cela me donne presque l'envie de me remettre à VBA ()

Hi,

JFL a écrit :

Cela me donne presque l'envie de me remettre à VBA ()

Disons que un mix des deux ne nuit nullement à la performance. Cependant, de plus en plus d'entreprises se protègent en enlevant la possibilité d'utiliser le VBA au sein de leur structure.

Cet exemple serait donc irréalisable dans de telles entités, hélas.

Merci pour ce témoignage (mais pas beaucoup de mérites, le plus dur était quand même le M )

Bonjour à tous de nouveau !

cousinhub a écrit :

....... Cependant, de plus en plus d'entreprises se protègent en enlevant la possibilité d'utiliser le VBA au sein de leur structure.

Sans pouvoir étayer, j'ai le sentiment que pour Microsoft, VBA n'est pas une solution d'avenir.....

Je n'avais pas vu la solution proposée, j'ai terminé la mienne trop tard

Ci-joint le fichier tout de meme, pour les curieux, solution toute VBA, en réutilisant une partie du code que j'avais mis en place pour une autre solution.

VBA Module :

Option Explicit

Public Sub CreateReport()
  Dim pickedRng As Range
  On Error Resume Next
  Set pickedRng = Application.InputBox("Veuillez sélectionner la 1e cellule de la colonne à traiter :", "Plage de données", ActiveSheet.Range("B2").Address, Type:=8)
  On Error GoTo 0
  ' quitter si aucune cellule selectionnée
  If pickedRng Is Nothing Then Exit Sub

  Dim inputRng As Range
  Set inputRng = Range(pickedRng, pickedRng.End(xlDown))

  ' trouver la profondeur maximale, ie. le niveau des produits dans l'exemple
  Dim depth As Long, itemRow As Variant
  For Each itemRow In inputRng.Rows
    depth = WorksheetFunction.Max(depth, itemRow.OutlineLevel)
  Next itemRow

  ' extraction de l'arbre des données
  Dim currentNode As Node
  Dim nodeList As New Collection          ' nodes, dans l'ordre d'apparition

  ' et de la liste des nodes à extraire = lignes du tableau d'export
  ' = Produits xyz et leurs valeurs
  Dim exportList As New Collection        ' node de +haut niveau & quantité

  For Each itemRow In inputRng
    Set currentNode = New Node
    currentNode.value = itemRow.Value2
    currentNode.quantity = itemRow.Offset(0, 1).Value2

    ' recherche d'un parent si profondeur > 1
    ' recherche en arrière pour trouver le dernier parent enregistré et non le premier
    ' ie. niveau immédiatement supérieur
    Dim currentLevel As Long, i As Long
    currentLevel = itemRow.Rows.OutlineLevel
    If currentLevel > 1 Then
      For i = nodeList.Count To 1 Step -1
        If nodeList(i).Level < currentLevel Then
          Set currentNode.parent = nodeList(i)
          Exit For
        End If
      Next i
    End If
    ' ajout du node dans la liste
    nodeList.Add currentNode

    ' ajout dans la liste d'export
    If currentNode.Level = depth Then
      exportList.Add currentNode
    End If

  Next itemRow

  ' Traitement de l'exportation
  ' creation d'une nouvelle feuille
  Dim expSheet As Worksheet
  Set expSheet = ThisWorkbook.Worksheets.Add(after:=ActiveSheet)
  expSheet.Name = "SYNTHESE_" & Format(pickedRng.Value2, "mmm-yy")

  ' creation des colonnes du tableau
  For i = depth To 1 Step -1
    expSheet.Cells(1, 1 + depth - i).Value2 = "Niveau " & i
  Next i
  expSheet.Cells(1, depth + 1).Value2 = "Quantité"

  ' export des nodes
  For i = 2 To exportList.Count
    expSheet.Cells(i, 1).Resize(1, depth) = exportList(i).toArray
    expSheet.Cells(i, depth + 1) = exportList(i).quantity
  Next i

  ' mise en forme
  expSheet.Cells.Columns.AutoFit
  Dim formatedTable As ListObject
  Set formatedTable = expSheet.ListObjects.Add(xlSrcRange, expSheet.UsedRange, , xlYes)

End Sub

Public Sub addToArray(ByVal item As Variant, arr As Variant)
  If TypeOf item Is Object  Then
    If IsEmpty(arr) Then
      ReDim arr(0 To 0)
      Set arr(0) = item
    ElseIf arr(UBound(arr)) Is Nothing Then
      Set arr(UBound(arr)) = item
    Else
      ReDim arr(LBound(arr) To UBound(arr) + 1)
      Set arr(UBound(arr)) = item
    End If

  Else
    If IsEmpty(arr) Then
      ReDim arr(0 To 0)
      arr(0) = item
    ElseIf arr(UBound(arr)) Is Nothing Then
      arr(UBound(arr)) = item
    Else
      ReDim arr(LBound(arr) To UBound(arr) + 1)
      arr(UBound(arr)) = item
    End If
  End If
End Sub

VBA Classe (réutilisée) :

Option Explicit

Private Type tNode
  value As String
  quantity As Double
  parent As Node
  children() As Node
End Type

Private this As tNode

Private Sub Class_Initialize()
  this.value = vbNullString
  this.quantity = 0#
  Dim childList() As Node
  ReDim childList(0 To 0)
  this.children = childList
End Sub

Public Function HasNoParent() As Boolean
  HasNoParent = this.parent Is Nothing
End Function

Public Function HasNoChildren() As Boolean
  HasNoChildren = UBound(this.children) < 2
End Function

Public Function Level() As Long
  'If HasNoParent Then
    Level = 1
  'Else
  On Error Resume Next
    Level = this.parent.Level + 1
  'End If
  On Error GoTo 0
End Function

Public Function toStr() As String
  If HasNoParent Then
    toStr = this.value
  Else
    toStr = this.parent.toStr & "/" & this.value
  End If
End Function

Public Sub addChild(ByVal child As Node)
  addToArray child, this.children
End Sub

Public Function toArray() As Variant
  Dim export() As String

  If HasNoParent Then
    ReDim export(0 To 0)
    export(0) = this.value
  Else
    ReDim export(1 To Level)
    Dim parentNode As Node, i As Long
    Set parentNode = Me
    i = Level
    Do
      export(i) = parentNode.value
      Set parentNode = parentNode.parent
      i = i - 1
    Loop Until parentNode.HasNoParent
    export(1) = parentNode.value
  End If
  toArray = export
End Function

' Getters and Setters

Public Property Get value() As String
  value = this.value
End Property

Public Property Get parent() As Node
  Set parent = this.parent
End Property

Public Property Get quantity() As Double
  quantity = this.quantity
End Property

Public Property Let value(ByVal value As String)
  this.value = value
End Property

Public Property Set parent(ByVal parent As Node)
  Set this.parent = parent
End Property

Public Property Let quantity(ByVal quantity As Double)
  this.quantity = quantity
End Property