Microsoft 365 Transposition de données automatiquement selon critères, c'est possible ?

Cherrylie

XLDnaute Junior
Bonjour à tous !

Je suis en train de travailler sur un document d'évaluation des risques, j'ai déjà réussi à faire le plus gros du travail mais je sèche complètement sur mon onglet "plan d'actions".

En effet, j'aimerai mettre en place un bouton qui permettrai de créer un tableau automatiquement à partir des données saisies dans l'onglet "synthèse des résultats" et où on pourrait choisir de créer des lignes que pour les risques qui sont supérieurs à 5 (par exemple). J'ai mis un exemple sur le fichier ci-joint.

Si quelqu'un a une idée, je vous en serait extrêmement reconnaissante car j'ai essayé de le faire avec un TCD mais ça ne donne pas ce que je recherche et mes connaissances en VBA sont très limitées... 😅

Merci d'avance !

Cherrylie


PS : pour des raisons de confidentialité, je n'ai pu vous mettre qu'un extrait de mon fichier mais normalement, toutes les infos sont sur ces deux onglets
 

Pièces jointes

  • Evaluation des risques plan d'actions.xlsm
    27.7 KB · Affichages: 13
Solution
Bonjour

Regarde la zone nommée Data qui récupère la plage de données ainsi que le nom Seuil attribué à la cellule qui contient le seuil.

Il y a 2 requêtes PowerQuery.
Lancer PowerQuery pour les voir : Données, Obtenir des données , Lancer PowerQuery

Synthèse
dont tu peux voir les étapes à droite :
  • récupère les données de la plage nommée Data
  • compte tenu des cellules fusionnées des titres de F à U il y a 8 étapes pour récupérer un tableau normalisé utilisable (étape qui pourraient être évitées si on partait d'un tableau structuré standard)
  • pivote le tableau pour obtenir une ligne par risque
  • filtre selon le seuil choisi
  • réordonne les colonnes
  • tri par numéro de risque (il faudrait...

chris

XLDnaute Barbatruc
Bonjour


Le tableau source gagnerait à être normalisé et mis sous forme de tableau structuré : j'ai du passer par une formule nommée

Une proposition PowerQuery

Si la source ou le choix du seuil évoluent Données, Actualiser Tout
 

Pièces jointes

  • Evaluation des risques plan d'actions_PQ.xlsm
    37.7 KB · Affichages: 9

Cherrylie

XLDnaute Junior
Bonjour Chris,

Merci beaucoup, c'est parfait !

Pouvez-vous m'expliquer comment vous avez procéder s'il-vous-plaît ? Je peux être amenée à refaire ce type de tableau à l'avenir...

Merci d'avance et encore merci pour votre aide

Cherrylie
 

chris

XLDnaute Barbatruc
Bonjour

Regarde la zone nommée Data qui récupère la plage de données ainsi que le nom Seuil attribué à la cellule qui contient le seuil.

Il y a 2 requêtes PowerQuery.
Lancer PowerQuery pour les voir : Données, Obtenir des données , Lancer PowerQuery

Synthèse
dont tu peux voir les étapes à droite :
  • récupère les données de la plage nommée Data
  • compte tenu des cellules fusionnées des titres de F à U il y a 8 étapes pour récupérer un tableau normalisé utilisable (étape qui pourraient être évitées si on partait d'un tableau structuré standard)
  • pivote le tableau pour obtenir une ligne par risque
  • filtre selon le seuil choisi
  • réordonne les colonnes
  • tri par numéro de risque (il faudrait trier par Numéro et Risque)
On affiche le résultat dans l'onglet Plan d'actions et on y ajoute les autres colonnes

Ces colonnes de saisie doivent être liées aux autres en cas d'évolution de la source (ou du seuil) qui déplacent les lignes.
Pour cela on doit utiliser la technique du self-referencing.
On charge le tableau résultat complété dans PowerQuery (requête Synthèse (2)) et on complète la requête Synthèse en la croisant avec Synthèse (2) sur les colonnes Numéro et Risque pour établir le lien.
 

Cherrylie

XLDnaute Junior
Re bonjour,

J'ai essayé de le faire mais la requête me dite qu'elle ne connaît pas la plage "Seuil" à l'étape lignes filtrées 1, je pense que c'est ma zone Data qui n'est pas bonne mais je ne sais pas comment la modifiée pour qu'elle prenne en compte le seuil... As-tu une idée ? Malheureusement, étant donné que je suis en train de l'appliquer sur un fichier confidentiel, je ne peux pas le mettre en pièce jointe...
 

Cherrylie

XLDnaute Junior
RE

La plage Seuil est la cellule nommée en B6 de Plan d''actions

Elle reçoit la valeur choisie pour le filtre

Je l'ai citée en 1ère ligne de mon #4
Re

C'est bon, j'ai résolu le problème, c'est ma zone Data qui était mal définie. J'ai recommencé et ça semble fonctionner.
J'ai juste un dernier souci : je n'arrive pas à afficher le tableau suite à la requête "Synthèse (2), je peux juste le mettre en-dessous de celui de la première requête. Comment dois-je procéder pour avoir qu'un seul tableau reprenant toutes les colonnes dont j'ai besoin ?

Merci encore pour ton aide et ta patience.

Cherrylie
 

chris

XLDnaute Barbatruc
RE

Tu crées la 1ère requête en t'arrêtant au tri comme expliqué au #4

Tu charges la requête dans l'onglet Plan d'actions
Tu ajoutes les colonnes à saisir à droite des autres
Tu cliques dans une cellule de ce tableau : Données, A partir d'un tableau : ce qui ouvres PQ avec cette requête Synthèse (2)
Tu te positionnes dans la 1ère Requête et tu la complètes : Accueil, Fusionner les requêtes. Sélectionner la requête Synthèse (2) puis, dans chacune, les colonnes Numéro et Risque en jointure externe gauche
1653233652691.png

valider.
Cliquer sur la double flèche en haut de la colonne Synthèse (2) puis décocher tout sauf les noms des 5 colonnes ajoutées.
Sortir par Fermer et charger dans, Connexion seulement
Les 5 colonnes apparaissent en double dans le tableau : supprimer celles qui ont un numéro à côté du titre.
 

Pièces jointes

  • 1653233700416.png
    1653233700416.png
    44.9 KB · Affichages: 18

job75

XLDnaute Barbatruc
Bonjour Cherrylie, chris, le forum,

Voyez le fichier joint et ces 2 macros dans le code de la feuille "Plan d'actions" :
VB:
Private Sub Worksheet_Activate()
Worksheet_Change [D6] 'lance la macro
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D6]) Is Nothing Then Exit Sub
Dim limite, d As Object, P As Range, tablo, i&, x$, nn&, resu(), c As Range, j%, n&, a
[D6].Select
limite = [D6]
'---liste concaténée sans doublon---
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
Set P = [A10].CurrentRegion.Resize(, 11) 'colonne K supplémentaire masquée
tablo = P 'matrice, plus rapide
For i = 2 To UBound(tablo)
    x = tablo(i, 1) & tablo(i, 2) & tablo(i, 3) & tablo(i, 4)
    tablo(i, 11) = IIf(d.exists(x) Or tablo(i, 4) <= limite, 1, "") 'repère
    d(x) = i 'mémorise la ligne
Next i
'---analyse du tableau source---
With Sheets("Synthèse des résultats")
    nn = Application.Count(.Range("F16:U" & .Rows.Count))
    If nn = 0 Then GoTo 1
    ReDim resu(nn - 1, 3) 'base 0
    For Each c In .Range("F16:U" & .Rows.Count).SpecialCells(xlCellTypeConstants, 1)
        i = c.Row: j = c.Column
        x = .Cells(i, 3) & .Cells(i, 2) & .Cells(9, j) & c
        If d.exists(x) Then
            d.Remove x 'retire de la liste
        ElseIf c > limite Then
            resu(n, 0) = .Cells(i, 3): resu(n, 1) = .Cells(i, 2)
            resu(n, 2) = .Cells(9, j): resu(n, 3) = c
            n = n + 1
        End If
    Next c
End With
'---reste de la liste---
If d.Count Then
    a = d.items
    For i = 0 To UBound(a)
        tablo(a(i), 11) = 1 'repère
    Next i
End If
'---restitution et mises en forme---
1 Application.ScreenUpdating = False
P.FormatConditions.Delete 'RAZ
P.Columns(11) = Application.Index(tablo, , 11)
If n Then P.Rows(P.Rows.Count + 1).Resize(n, 4) = resu
Set P = P.Resize(P.Rows.Count + n)
P.Borders.Weight = xlThin 'bordures
P.FormatConditions.Add xlExpression, Formula1:="=$K10=1" 'Mise en forme conditionnelle (MFC)
P.FormatConditions(1).Interior.Color = RGB(217, 217, 217) 'gris
End Sub
Elles s'exécutent automatiquement quand on modifie la cellule D6 ou qu'on active la feuille.

Aucune ligne du tableau n'est supprimée, simplement les lignes qui ne répondent plus au critère sont colorées en gris.

A+
 

Pièces jointes

  • Evaluation des risques plan d'actions(1).xlsm
    33.9 KB · Affichages: 11

Cherrylie

XLDnaute Junior
Bonjour Cherrylie, chris, le forum,

Voyez le fichier joint et ces 2 macros dans le code de la feuille "Plan d'actions" :
VB:
Private Sub Worksheet_Activate()
Worksheet_Change [D6] 'lance la macro
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D6]) Is Nothing Then Exit Sub
Dim limite, d As Object, P As Range, tablo, i&, x$, nn&, resu(), c As Range, j%, n&, a
[D6].Select
limite = [D6]
'---liste concaténée sans doublon---
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
Set P = [A10].CurrentRegion.Resize(, 11) 'colonne K supplémentaire masquée
tablo = P 'matrice, plus rapide
For i = 2 To UBound(tablo)
    x = tablo(i, 1) & tablo(i, 2) & tablo(i, 3) & tablo(i, 4)
    tablo(i, 11) = IIf(d.exists(x) Or tablo(i, 4) <= limite, 1, "") 'repère
    d(x) = i 'mémorise la ligne
Next i
'---analyse du tableau source---
With Sheets("Synthèse des résultats")
    nn = Application.Count(.Range("F16:U" & .Rows.Count))
    If nn = 0 Then GoTo 1
    ReDim resu(nn - 1, 3) 'base 0
    For Each c In .Range("F16:U" & .Rows.Count).SpecialCells(xlCellTypeConstants, 1)
        i = c.Row: j = c.Column
        x = .Cells(i, 3) & .Cells(i, 2) & .Cells(9, j) & c
        If d.exists(x) Then
            d.Remove x 'retire de la liste
        ElseIf c > limite Then
            resu(n, 0) = .Cells(i, 3): resu(n, 1) = .Cells(i, 2)
            resu(n, 2) = .Cells(9, j): resu(n, 3) = c
            n = n + 1
        End If
    Next c
End With
'---reste de la liste---
If d.Count Then
    a = d.items
    For i = 0 To UBound(a)
        tablo(a(i), 11) = 1 'repère
    Next i
End If
'---restitution et mises en forme---
1 Application.ScreenUpdating = False
P.FormatConditions.Delete 'RAZ
P.Columns(11) = Application.Index(tablo, , 11)
If n Then P.Rows(P.Rows.Count + 1).Resize(n, 4) = resu
Set P = P.Resize(P.Rows.Count + n)
P.Borders.Weight = xlThin 'bordures
P.FormatConditions.Add xlExpression, Formula1:="=$K10=1" 'Mise en forme conditionnelle (MFC)
P.FormatConditions(1).Interior.Color = RGB(217, 217, 217) 'gris
End Sub
Elles s'exécutent automatiquement quand on modifie la cellule D6 ou qu'on active la feuille.

Aucune ligne du tableau n'est supprimée, simplement les lignes qui ne répondent plus au critère sont colorées en gris.

A+
Bonjour Job75,

Merci pour ta solution. Je vais essayer de l'appliquer à mon fichier initial. Je proposerai ensuite les deux versions (de toi et Chris) à ma Direction et ils choisiront la version qu'ils préfèrent.

Un immense merci à vous deux pour votre aide !



Thanks Thank You GIF by 大姚Dayao


Cherrylie
 

Cherrylie

XLDnaute Junior
Bonjour Cherrylie, chris, le forum,

Voyez le fichier joint et ces 2 macros dans le code de la feuille "Plan d'actions" :
VB:
Private Sub Worksheet_Activate()
Worksheet_Change [D6] 'lance la macro
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D6]) Is Nothing Then Exit Sub
Dim limite, d As Object, P As Range, tablo, i&, x$, nn&, resu(), c As Range, j%, n&, a
[D6].Select
limite = [D6]
'---liste concaténée sans doublon---
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
Set P = [A10].CurrentRegion.Resize(, 11) 'colonne K supplémentaire masquée
tablo = P 'matrice, plus rapide
For i = 2 To UBound(tablo)
    x = tablo(i, 1) & tablo(i, 2) & tablo(i, 3) & tablo(i, 4)
    tablo(i, 11) = IIf(d.exists(x) Or tablo(i, 4) <= limite, 1, "") 'repère
    d(x) = i 'mémorise la ligne
Next i
'---analyse du tableau source---
With Sheets("Synthèse des résultats")
    nn = Application.Count(.Range("F16:U" & .Rows.Count))
    If nn = 0 Then GoTo 1
    ReDim resu(nn - 1, 3) 'base 0
    [COLOR=rgb(251, 160, 38)]For Each c In .Range("F16:U" & .Rows.Count).SpecialCells(xlCellTypeConstants, 1)[/COLOR]
        i = c.Row: j = c.Column
        x = .Cells(i, 3) & .Cells(i, 2) & .Cells(9, j) & c
        If d.exists(x) Then
            d.Remove x 'retire de la liste
        ElseIf c > limite Then
            resu(n, 0) = .Cells(i, 3): resu(n, 1) = .Cells(i, 2)
            resu(n, 2) = .Cells(9, j): resu(n, 3) = c
            n = n + 1
        End If
    Next c
End With
'---reste de la liste---
If d.Count Then
    a = d.items
    For i = 0 To UBound(a)
        tablo(a(i), 11) = 1 'repère
    Next i
End If
'---restitution et mises en forme---
1 Application.ScreenUpdating = False
P.FormatConditions.Delete 'RAZ
P.Columns(11) = Application.Index(tablo, , 11)
If n Then P.Rows(P.Rows.Count + 1).Resize(n, 4) = resu
Set P = P.Resize(P.Rows.Count + n)
P.Borders.Weight = xlThin 'bordures
P.FormatConditions.Add xlExpression, Formula1:="=$K10=1" 'Mise en forme conditionnelle (MFC)
P.FormatConditions(1).Interior.Color = RGB(217, 217, 217) 'gris
End Sub
Elles s'exécutent automatiquement quand on modifie la cellule D6 ou qu'on active la feuille.

Aucune ligne du tableau n'est supprimée, simplement les lignes qui ne répondent plus au critère sont colorées en gris.

A+
Re !

J'ai un petit souci avec la macro, il y a un message d'erreur qui me dit que le problème vient de la ligne "For Each c In .Range("F16:U" & .Rows.Count).SpecialCells(xlCellTypeConstants, 1)". Je pense que c'est parce que les cellules sont fusionnées. Pourtant, dans le fichier que tu m'as transmi, elles sont fusionnées également...

Aurais-tu une idée pour la faire fonctionner ?

Merci d'avance.

Cherrylie
 

job75

XLDnaute Barbatruc
Bonjour Cherrylie, le forum,

Sur le fichier de mon post #12, feuille "Synthèse des résultats", il n'y a pas de cellules fusionnées dans la plage .Range("F16:U" & .Rows.Count) et si l'on fusionne par exemple P20 et Q20 il n'y a aucun problème.

A+
 

Discussions similaires

Réponses
3
Affichages
251
Réponses
9
Affichages
150

Membres actuellement en ligne

Statistiques des forums

Discussions
312 084
Messages
2 085 194
Membres
102 814
dernier inscrit
JLGalley