Power Query Fractionner et modifier les colonnes d'un tableau

[Manu Bores]

Bonjour,
Au travail, j'ai un logiciel qui exporte dans Excel des listes de factures sous un forme totalement inexploitable.
Voici un aperçu de l'export :

Je voudrais obtenir 3 colonnes pour chaque article : "Eau Part fixe.HT", "Eau Part fixe.TVA", "Eau Part fixe.TTC". Idem pour les colonnes suivantes.
Dans Power Query, je sais fractionner une colonne par délimiteur (ici le délimiteur est le saut de ligne), puis renommer la colonne et la nettoyer pour ne garder que les nombres. Mais je suis obligé de recommencer pour chaque colonne.
De plus, d'un export à l'autre, je n'ai pas le même nombre de colonnes à fractionner, et les colonnes n'ont pas toujours le même nom.
J'arrive à récupérer la liste des entêtes de colonnes que je veux fractionner (avec la fonction Table.ColumnNames), mais je ne parviens pas à utiliser cette liste comme paramètre dans ma requête.

Comment automatiser ce travail, pour obtenir une requête capable de transformer mes différents exports ?
Merci de votre aide

Ci-joint un exemple de fichier Excel à retravailler.

 

[job75]

Merci bsalv, en effet c'est très rapide mais je n'ai pas compris pourquoi ça va aussi vite.

En attendant je continue avec cette version (3) qui n'insère plus de colonnes (le tableau structuré est redimensionné) :

Private Sub Worksheet_Activate()
Dim ncol1%, ncol2%, plage As Range, col%, Tcible, Tsource, n%, i&, x$, p%
Application.ScreenUpdating = False
Cells.Delete 'RAZ
Sheets("Import").ListObjects(1).Range.EntireColumn.Copy Cells(1) 'copier-coller du tableau structuré
With ListObjects(1) 'tableau structuré
    .TableStyle = "TableStyleMedium3" 'le style que vous voulez
    ncol1 = .Range.Columns.Count
    ncol2 = 3 + 3 * (ncol1 - 3)
    Set plage = .Range.Resize(, ncol2)
    .Resize plage 'redimensionne le tableau
    .Unlist 'convertit le tableau en plage
End With
With plage
    .Cells(1, ncol1 + 1).Resize(, ncol2 - ncol1).ClearContents
    .Rows(2).Insert xlDown 'insère la ligne des sous-titres
    For col = ncol2 - 2 To 4 Step -3
        .Cells(2, col).Resize(, 3) = Array("HT", "TVA", "TTC")
        Tcible = .Columns(col).Resize(, 3) 'matrice, plus rapide
        Tsource = .Columns(ncol1 - n): If col > 4 Then .Columns(ncol1 - n).ClearContents: n = n + 1
        Tcible(1, 1) = Tsource(1, 1) 'titre
        For i = 3 To UBound(Tcible)
            x = Tsource(i, 1)
            p = InStr(x, "HT"): If p Then Tcible(i, 1) = Val(Replace(Replace(Replace(Mid(x, p + 2), Chr(160), ""), ":", ""), ",", "."))
            p = InStr(x, "TVA"): If p Then Tcible(i, 2) = Val(Replace(Replace(Replace(Mid(x, p + 3), Chr(160), ""), ":", ""), ",", "."))
            p = InStr(x, "TTC"): If p Then Tcible(i, 3) = Val(Replace(Replace(Replace(Mid(x, p + 3), Chr(160), ""), ":", ""), ",", "."))
        Next i
        .Columns(col).Resize(, 3) = Tcible 'restitution
    Next col
    '---formats---
    With .Columns(4).Resize(, .Columns.Count - 3)
        .HorizontalAlignment = xlCenter
        .ColumnWidth = 12.5
        .NumberFormat = "#,##0.00 €"
    End With
    .Rows(2).Borders(xlEdgeTop).Weight = xlThin
    .Resize(1, 3).Borders(xlEdgeBottom).LineStyle = xlNone
    n = .Borders(xlEdgeLeft).Weight 'bordure du contour
    For col = 4 To .Columns.Count Step 3
        .Columns(col).Resize(1, 3).HorizontalAlignment = xlCenterAcrossSelection
        .Columns(col).Resize(, 3).Borders(xlEdgeLeft).Weight = n 'complète le contour des 3 colonnes
    Next col
    .Rows.AutoFit 'ajustement hauteurs
    .Resize(2).RowHeight = 25 'titres et sous-titres
    .Rows(1).Select: ActiveWindow.Zoom = True 'ajuste le zoom
    Application.Goto .Cells(1), True 'cadrage
End With
With ActiveWindow: .FreezePanes = False: .SplitRow = 2: .FreezePanes = True: End With 'fige les volets
End Sub

Edit : j'ai revu les bordures.

Sur 9 000 lignes la macro s'exécute chez moi en 15 secondes.

 

[bsalv]

quelque avis
* minimaliser le nombre de manipulations de la feuille
- 1 fois lire le contenu de la feuille "Import"
- 1 fois écraser le contenu dans le TS de traitement

* minimaliser les autres manipulations au lieu de supprimer tout et reconstruire à chaque fois
- mise à jour du nombre de listcolonnes = insérer des colonnes (multiple de 3) après la 6eme colonne ou supprimer au bout, comme ça, les bordures s'ajustent avec la MFC et le format monétaire est aussi appliqué, donc très facile
- mise a jour du nombre de listrows : si le nombre de lignes est supérieur au nombre actuel = pas d'ajustements à faire après le colle des données, autrement, on n'a qu'à supprimer les lignes supplémentaires = plus rapide au lieu de supprimer touteds les lignes et puis ajouter
- puis des autres petites choses


.

 

[job75]

Bonsoir le forum,

Je reviens avec une version (4) beaucoup plus rapide.

Le tableau source est copié seulement en valeurs et les formats sont propagés par AutoFill :

Private Sub Worksheet_Activate()
Dim LO As ListObject, ncol1%, ncol2%, nlig&, col%, Tcible, Tsource, n%, i&, x$, p%, style$
Application.ScreenUpdating = False
Cells.Delete 'RAZ
Set LO = Sheets("Import").ListObjects(1) 'tableau structuré
LO.Range.Copy
Cells(1).PasteSpecial xlPasteValues 'colle seulement les valeurs
ncol1 = UsedRange.Columns.Count
ncol2 = 3 + 3 * (ncol1 - 3)
UsedRange.Rows(2).Insert xlDown 'insère la ligne des sous-titres
nlig = UsedRange.Rows.Count
If nlig = 1 Then nlig = 2 'si le tableau est vide
With UsedRange.Resize(nlig, ncol2)
    For col = ncol2 - 2 To 4 Step -3
        .Cells(2, col).Resize(, 3) = Array("HT", "TVA", "TTC")
        Tcible = .Columns(col).Resize(, 3) 'matrice, plus rapide
        Tsource = .Columns(ncol1 - n): If col > 4 Then .Columns(ncol1 - n).ClearContents: n = n + 1
        Tcible(1, 1) = Tsource(1, 1) 'titre
        For i = 3 To UBound(Tcible)
            x = Tsource(i, 1)
            p = InStr(x, "HT"): If p Then Tcible(i, 1) = Val(Replace(Replace(Replace(Mid(x, p + 2), Chr(160), ""), ":", ""), ",", "."))
            p = InStr(x, "TVA"): If p Then Tcible(i, 2) = Val(Replace(Replace(Replace(Mid(x, p + 3), Chr(160), ""), ":", ""), ",", "."))
            p = InStr(x, "TTC"): If p Then Tcible(i, 3) = Val(Replace(Replace(Replace(Mid(x, p + 3), Chr(160), ""), ":", ""), ",", "."))
        Next i
        .Columns(col).Resize(, 3) = Tcible 'restitution
    Next col
    '---couleurs sur 4 lignes---
    n = IIf(nlig < 4, nlig, 4) 'si moins de 4 lignes
    style = LO.TableStyle 'mémorise
    LO.TableStyle = "TableStyleMedium3" 'le style que vous voulez
    .Resize(2).Interior.Color = LO.Range(1).DisplayFormat.Interior.Color
    .Resize(2).Font.Color = LO.Range(1).DisplayFormat.Font.Color
    .Resize(2).Font.Bold = True 'gras
    If n > 2 Then .Rows(3).Interior.Color = LO.Range(2, 1).DisplayFormat.Interior.Color
    If n > 3 Then .Rows(4).Interior.Color = LO.Range(3, 1).DisplayFormat.Interior.Color
    LO.TableStyle = style 'état initial
    '---bordures et formats sur 4 lignes---
    .Resize(n).Borders.Weight = xlThin
    .Resize(1, 3).Borders(xlEdgeBottom).LineStyle = xlNone
    .Resize(n).BorderAround xlDouble 'contour bordure double
    .Rows(n).Borders(xlEdgeBottom).Weight = xlThin 'sauf ligne du bas
    For col = 1 To 3: .Columns(col).ColumnWidth = LO.Range(1, col).ColumnWidth: Next col
    .Resize(n, 3).WrapText = True 'renvoi à la ligne
    With .Columns(4).Resize(n, ncol2 - 3)
        .HorizontalAlignment = xlCenter
        .ColumnWidth = 12.5 'à adapter
        .NumberFormat = "#,##0.00 €"
    End With
    For col = 4 To ncol2 Step 3
        .Columns(col).Resize(1, 3).HorizontalAlignment = xlCenterAcrossSelection
        .Columns(col).Resize(n, 3).Borders(xlEdgeLeft).LineStyle = xlDouble 'bordure double
    Next col
    '---propagation des formats sur toutes les lignes---
    If nlig > 4 Then .Rows("3:4").AutoFill .Rows(3).Resize(nlig - 2), xlFillFormats
    .Rows(nlig).Borders(xlEdgeBottom).LineStyle = xlDouble 'bordure double en dernière ligne
    '---fin---
    .Resize(2).RowHeight = 25 'titres et sous-titres
    .Rows(1).Select: ActiveWindow.Zoom = True 'ajuste le zoom
    Application.Goto .Cells(1), True 'cadrage
End With
ActiveWindow.SplitRow = 2: ActiveWindow.FreezePanes = True 'fige les volets
End Sub

Sur 9 000 lignes la macro s'exécute maintenant en 1,25 seconde chez moi.

A+

 

[job75]

Bonjour,

Pour peaufiner, cette version (4 bis) colore en blanc (ou en noir) les bordures des titres et sous-titres :

    '---fin---
    .Resize(2).RowHeight = 25 'titres et sous-titres
    coulborduretitre = IIf(.Cells(1).Font.Color = vbWhite, vbWhite, vbBlack)
    Columns(4).Resize(1, ncol2 - 3).Borders(xlEdgeBottom).Color = coulborduretitre
    For col = 2 To ncol2
        Columns(col).Resize(2).Borders(xlEdgeLeft).Color = coulborduretitre
    Next col

A+