Faire un tableau récapitulaitif par utilisateur

[didinelfange]

Bonjour,

J'aurai encore besoin de votre aide sur une macro qui me permettrait de faire un tableau récapitulatif. Je m'explique:
Dans une extraction de droits d'accès utilisateur, j'ai les infos suivantes:
- une liste d'applications
- une liste d'utilisateurs de ces applications
- des services dans les applications (les utilisateurs n'ont pas tous accès aux mêmes services).

Or, l'extraction ne tient pas compte des services non autorisés à certaines personnes, et inscrit tous les services en lignes sans laisser de cellules blanches quand il n'y a pas d'autorisation sur le service .

Pour être plus clair, je vous joins un fichier exemple :
en page 1, les données brutes
en page 12, le tableau souhaité

Pour un autre besoin, j'ai créé au préalable une macro qui me permet de créer une feuille et d'extraire les données par application . Si ça peut aider.

Je précise aussi que ce fichier est régulièrement peuplé de nouvelles applications avec leurs services respectifs, ainsi que de nouveaux utilisateurs. il faut donc que la macro soit évolutive.

Je vous remercie par avance de votre réponse. Et un grand merci pour votre aide depuis quelques jours (je n'aurai pas pu progresser aussi vite sans vous).

 

[Dranreb]

Re : Faire un tableau récapitulaitif par utilisateur

Bonjour.
Voyez si ça convient.

J'ai ajouté un commentaire devant chaque étape.

 

[didinelfange]

Re : Faire un tableau récapitulaitif par utilisateur

Bonjour,

Je vous remercie énormément pour votre aide. Sur le fichier exemple, cela fonctionne. J'ai juste un tout petit problème, je ne comprends rien à votre code . Or, je dois l'adapter sur un fichier confidentiel de mon entreprise et je ne sais pas quoi modifier, il y a des commentaires sur chaque feuille mais je ne sais pas dans quel ordre lancer les macros .
Je suis vraiment désolé mais cette macro est très compliquée pour moi, pourriez vous me donner les différentes étapes pour arriver à ce résultat.

Je vous remercie par avance de votre aide, et désolé mais je suis complètement perdue.

 

[Dranreb]

Re : Faire un tableau récapitulaitif par utilisateur

La programmation d'application est dans le module Feuil13. C'est une Sub Worksheet_Activate. Ça s'exécute donc quand on active la feuille.
Elle a besoin pour tourner des fournitures suivantes :
1 — Le module de service standard MClassement,
2 — Le module de service standard Utilit,
3 — Le module de classe SsGroup,
4 — Le module de classe TableIndex,
5 — La bibliothèque Scripting. C'est la référence "Microsoft Scripting Runtime" à cocher, menu Outils, Références…

 

[Dranreb]

Re : Faire un tableau récapitulaitif par utilisateur

Bonjour.
J'ajouterai que seul trois dispositifs y sont directement utilisés:
1 — La fonction PlgUti du module Utilit qui renvoie toute la plage utilisée à partir d'une expression Range d'une seule ligne spécifiée
2 — La fonction DicInvent du module MClassement qui renvoie un dictionnaire (on l'utilise pour retrouver à la fin le numéro de la colonne où il faut mettre un "x" en fonction de l'application et du service)
3 — La fonction GroupOrg du module MClassement, très puissante puisqu'elle reclasse et réorganise en collections emboîtées les données d'un tableau ou d'une plage spécifié d'abord, selon certaines colonnes également spécifiées derrière.
Lorsque c'est un tableau qui a été surdimensionné, DernièreLigneIdx de MClassement peut recevoir le nombre de lignes à en considérer juste après.
Avez vous d'autres questions ?

 

[klin89]

Re : Faire un tableau récapitulaitif par utilisateur

Bonsoir Dranreb, didinelfange, le forum

Si la structure des données figurant en Feuil 1 ne change pas.

A tester avec le fichier du post #1, restitution en Feuil2.
Supprime bien la zone fusionnée en G5:H6

Option Explicit

Sub test()
Dim a, b(), i As Long, j As Long, n As Long, t As Long, ref As Long, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    With Sheets("Feuil1").Range("a1").CurrentRegion
        a = .Value
        ReDim b(1 To UBound(a, 1), 1 To Application.CountA(.Columns(1).Cells) * UBound(a, 2))
    End With
    n = 2: t = 1: b(2, 1) = "Users"
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 2 To UBound(a, 1)
            If Not dico.exists(a(i, 2)) Then
                n = n + 1: dico(a(i, 2)) = n
                b(n, 1) = a(i, 2)
            End If
            If a(i, 1) <> "" Then ref = i
            If Not .exists(a(ref, 1)) Then
                Set .Item(a(ref, 1)) = _
                CreateObject("Scripting.Dictionary")
                .Item(a(ref, 1)).CompareMode = 1
                b(1, t + 1) = a(ref, 1)
            End If
            For j = 3 To UBound(a, 2)
                If a(i, j) <> "" Then
                    If Not .Item(a(ref, 1)).exists(a(i, j)) Then
                        Set .Item(a(ref, 1))(a(i, j)) = _
                        CreateObject("Scripting.Dictionary")
                        .Item(a(ref, 1))(a(i, j)).CompareMode = 1
                        t = t + 1
                        .Item(a(ref, 1))(a(i, j)) = t
                        b(2, t) = a(i, j)
                    End If
                    b(dico(a(i, 2)), .Item(a(ref, 1))(a(i, j))) = "x"
                End If
            Next
        Next
    End With
    Application.ScreenUpdating = False
    'restitution et mise en forme
    With Sheets("Feuil2")
        .Cells.Clear
        With .Cells(1).Resize(n, t)
            .Value = b
            .Font.Name = "calibri"
            .Font.Size = 10
            .VerticalAlignment = xlCenter
            .HorizontalAlignment = xlCenter
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            With .Rows(1)
                .BorderAround Weight:=xlThin
                .SpecialCells(2).Interior.ColorIndex = 36
            End With
            With .Rows(2)
                .BorderAround Weight:=xlThin
                .Offset(, 1).Resize(, .Columns.Count - 1).Interior.ColorIndex = 44
            End With
            .Columns.ColumnWidth = 11
        End With
        .Activate
    End With
    Application.ScreenUpdating = True
End Sub

klin89

 

[didinelfange]

Re : Faire un tableau récapitulaitif par utilisateur

bonjour à tous,

Je vous remercie infiniment pour votre aide. Je ne sais pas comment vous remercier, vous m'avez épargné des semaines de travail sur ce sujet. J'ai juste une dernière question concernant le code de Klin89, pour pouvoir l'adapter à mon fichier. Peux tu m'indiquer à quoi correspondent les variables a, b, i, j, n, t .... car ces variables ne me parlent pas pour me repérer dans le tableau.

Je vous remercie de votre patience et de votre temps que vous consacrez à ma demande.

Infiniment merci.

 

[Dranreb]

Re : Faire un tableau récapitulaitif par utilisateur

Bonjour.

Heu … ma programmation n'utilise que 3 indices : L, C et LU, soit chaque fois comme Ligne et Colonne, avec un U derrière pour la ligne du tableau intermédiaire TU. N'est ce pas clair non plus ?
Préfèreriez vous que ma procédure soit aussi dans un module standard, quitte à la lancer manuellement ou par un bouton, plutôt que dans le module de la feuille Feuil13 ? Il suffirait de remplacer à la fin Me par Feuil13 ou, si vous y teniez, par ThisWorkbook.Worksheets("Feuil13"). Mais je trouve ça plus long…

 

[klin89]

Re : Faire un tableau récapitulaitif par utilisateur

Bonjour à tous,

Pour le fun, une autre présentation.
Restitution en Feuil3 :

Option Explicit
Sub test()
Dim a, i As Long, j As Long, w(), n, y, x, ref As Long, posR, posC
    With Sheets("Feuil1").Range("a1").CurrentRegion
        a = .Value
        y = Application.Index(a, 1, Evaluate("transpose(row(3:" & UBound(a, 2) & "))"))
        With .Offset(1)
            x = Filter(.Parent.Evaluate("transpose(if(countif(offset(" & .Columns(2).Address & ",,,row(1:" & .Rows.Count & "))," & _
               .Columns(2).Address & ")=1," & .Columns(2).Address & ",char(2)))"), Chr(2), 0)
        End With
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 2 To UBound(a, 1)
                If a(i, 1) <> "" Then ref = i
                If Not .exists(a(ref, 1)) Then
                    ReDim w(1 To UBound(x) + 3, 1 To UBound(y) + 1)
                    w(1, 1) = a(ref, 1): w(2, 1) = "Users"
                    For j = 3 To UBound(w, 1)
                        w(j, 1) = x(j - 3)
                    Next
                    For j = 2 To UBound(w, 2)
                        w(2, j) = y(j - 1)
                    Next
                    .Item(a(ref, 1)) = w
                End If
                w = .Item(a(ref, 1))
                posR = Application.Match(a(i, 2), x, 0)
                For j = 3 To UBound(a, 2)
                    If a(i, j) <> "" Then
                        posC = Application.Match(a(i, j), y, 0)
                        w(posR + 2, posC + 1) = "x"
                    End If
                Next
                .Item(a(ref, 1)) = w
            Next
            x = .keys: y = .items
        End With
        Application.ScreenUpdating = False
        'Restitution et mise forme
        With Sheets("Feuil3").Cells(1)
            .Parent.Cells.Clear
            For i = 0 To UBound(x)
                With .Offset(n).Resize(UBound(y(i), 1), UBound(y(i), 2))
                    .Value = _
                    Application.Transpose(Application.Transpose(y(i)))
                    With .Offset(1).Resize(.Rows.Count - 1)
                        .BorderAround Weight:=xlThin
                        .Borders(xlInsideVertical).Weight = xlThin
                    End With
                    .Rows(2).BorderAround Weight:=xlThin
                    .Cells(1, 1).Font.Bold = True
                    .Cells(2, 1).Interior.ColorIndex = 36
                    .Columns(1).Offset(2).Resize(.Rows.Count - 2).Interior.ColorIndex = 44
                    .Rows(2).Offset(, 1).Resize(, .Columns.Count - 1).Interior.ColorIndex = 43
                    n = n + .Rows.Count + 1
                End With
            Next
            With .Parent.UsedRange
                .Font.Name = "calibri"
                .Font.Size = 10
                .VerticalAlignment = xlCenter
                .HorizontalAlignment = xlCenter
            End With
            .Parent.Activate
        End With
        Application.ScreenUpdating = True
    End With
End Sub

klin89

 

[didinelfange]

Re : Faire un tableau récapitulaitif par utilisateur

Bonjour à tous,

Je viens seulement de reprendre ma macro et je suis confronté à un problème avec le code de Klin89. En effet, j'ai oublié de préciser que les entêtes jaunes que j'ai mis dans le fichier exemple n'existe pas dans mon fichier d'entreprise.

Ainsi, je vous joins le fichier qui correspond trait pour trait à mon fichier d'entreprise sans les infos confidentielles. mais avec exactement la même disposition .

Je vous remercie encore pour votre aide. Je suis pas loin d'avoir la bonne solution avec toutes vos réponses. Encore un petit coup de pouce si possible et je vous embêterai plus.

Je vous remercie mille fois pour vos réponses.

 

[klin89]

Re : Faire un tableau récapitulaitif par utilisateur

Re didinelfange,

Je n'ai pas vraiment testé
Avec le fichier du post #10

Option Explicit

Sub test()
Dim a, b(), i As Long, j As Long, n As Long, t As Long, ref As Long, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    With Sheets("Feuil1").Range("a1").CurrentRegion
        a = .Value
        ReDim b(1 To UBound(a, 1), 1 To Application.CountA(.Columns(1).Cells) * UBound(a, 2))
    End With
    n = 2: t = 3
    b(2, 1) = "N°": b(2, 2) = "Nom": b(2, 3) = "Prénom"
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 1 To UBound(a, 1)
            If Not dico.exists(a(i, 2)) Then
                n = n + 1: dico(a(i, 2)) = n
                b(n, 1) = a(i, 2): b(n, 2) = a(i, 3): b(n, 3) = a(i, 4)
            End If
            If a(i, 1) <> "" Then ref = i
            If Not .exists(a(ref, 1)) Then
                Set .Item(a(ref, 1)) = _
                CreateObject("Scripting.Dictionary")
                .Item(a(ref, 1)).CompareMode = 1
                b(1, t + 1) = a(ref, 1)
            End If
            For j = 5 To UBound(a, 2)
                If a(i, j) <> "" Then
                    If Not .Item(a(ref, 1)).exists(a(i, j)) Then
                        Set .Item(a(ref, 1))(a(i, j)) = _
                        CreateObject("Scripting.Dictionary")
                        .Item(a(ref, 1))(a(i, j)).CompareMode = 1
                        t = t + 1
                        .Item(a(ref, 1))(a(i, j)) = t
                        b(2, t) = a(i, j)
                    End If
                    b(dico(a(i, 2)), .Item(a(ref, 1))(a(i, j))) = "x"
                End If
            Next
        Next
    End With
    Application.ScreenUpdating = False
    'restitution et mise en forme
    With Sheets("Feuil2")
        .Cells.Clear
        With .Cells(1).Resize(n, t)
            .Value = b
            .Font.Name = "calibri"
            .Font.Size = 10
            .VerticalAlignment = xlCenter
            .HorizontalAlignment = xlCenter
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            With .Rows(1)
                .BorderAround Weight:=xlThin
                .SpecialCells(2).Interior.ColorIndex = 36
            End With
            With .Rows(2)
                .BorderAround Weight:=xlThin
                .Resize(, 3).Interior.ColorIndex = 39
                .Offset(, 3).Resize(, .Columns.Count - 3).Interior.ColorIndex = 44
            End With
            .Columns.ColumnWidth = 11
        End With
        .Activate
    End With
    Application.ScreenUpdating = True
End Sub

klin89

 

[didinelfange]

Re : Faire un tableau récapitulaitif par utilisateur

Mille mercis ça marche !!!

 

[didinelfange]

Re : Faire un tableau récapitulaitif par utilisateur

Bonjour,

Avant tout, je vous remercie pour tous vos conseils et votre temps consacré à mon projet.
J'ai présenté ce matin un tableau récapitulatif qui marche très bien à mon chef.
Or, pour que ce soit vraiment nickel, il souhaiterait que je fusionne les cellules de la ligne 1 du tableau par application et si possible de réduire au maximum les colonnes par application voici un exemple de ce qu'il souhaite avoir ci-dessous.
Dans la Feuil2, j'ai mis un exemple des cellules à fusionner, et dans la Feuil3, vous avez un aperçu du rendu après repli des cellules
En fait, le principe serait de pouvoir grouper les colonnes par appli et de les réduire pour ne voir apparaitre que le numéro de l'appli.

Je vous remercie par avance de votre patience avec moi et de vos réponses toujours éclairées.

 

[klin89]

Re : Faire un tableau récapitulaitif par utilisateur

Re didinelfange,

Avec le fichier du post #13

Option Explicit

Sub test()
Dim a, b(), i As Long, j As Long, n As Long, t As Long
Dim dico As Object, r As Range, Couleurs
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    Couleurs = VBA.Array(40, 36, 43, 22)
    With Sheets("Feuil1").Range("a1").CurrentRegion
        a = .Value
        ReDim b(1 To UBound(a, 1), 1 To Application.CountA(.Columns(1).Cells) * UBound(a, 2))
    End With
    n = 2: t = 3
    b(2, 1) = "N°": b(2, 2) = "Nom": b(2, 3) = "Prénom"
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 1 To UBound(a, 1)
            If a(i, 1) = "" Then a(i, 1) = a(i - 1, 1)
            If Not dico.exists(a(i, 2)) Then
                n = n + 1: dico(a(i, 2)) = n
                b(n, 1) = a(i, 2): b(n, 2) = a(i, 3): b(n, 3) = a(i, 4)
            End If
            If Not .exists(a(i, 1)) Then
                Set .Item(a(i, 1)) = _
                CreateObject("Scripting.Dictionary")
                .Item(a(i, 1)).CompareMode = 1
                b(1, t + 1) = a(i, 1)
            End If
            For j = 5 To UBound(a, 2)
                If a(i, j) <> "" Then
                    If Not .Item(a(i, 1)).exists(a(i, j)) Then
                        Set .Item(a(i, 1))(a(i, j)) = _
                        CreateObject("Scripting.Dictionary")
                        .Item(a(i, 1))(a(i, j)).CompareMode = 1
                        t = t + 1
                        .Item(a(i, 1))(a(i, j)) = t
                        b(2, t) = a(i, j)
                    End If
                    b(dico(a(i, 2)), .Item(a(i, 1))(a(i, j))) = "x"
                End If
            Next
        Next
    End With
    Application.ScreenUpdating = False
    'restitution et mise en forme
    With Sheets("Feuil2")
        .Cells.Clear
        With .Cells(1).Resize(n, t)
            .Value = b
            .Font.Name = "calibri"
            .Font.Size = 10
            .VerticalAlignment = xlCenter
            .HorizontalAlignment = xlCenter
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            .Columns.ColumnWidth = 11
            With .Rows(1)
                .BorderAround Weight:=xlThin
                With .Offset(, 3).Resize(, .Columns.Count - 3)
                    n = 0
                    For Each r In .SpecialCells(4).Areas
                        r(0).Resize(, r.Cells.Count + 1).Interior.ColorIndex = Couleurs(n)
                        r(0).Resize(, r.Cells.Count + 1).MergeCells = True
                        n = n + 1
                        If n > UBound(Couleurs) Then n = 0
                        r.EntireColumn.Hidden = True
                    Next
                End With
            End With
            With .Rows(2)
                .BorderAround Weight:=xlThin
                .Resize(, 3).Interior.ColorIndex = 15
                .Offset(, 3).Resize(, .Columns.Count - 3).Interior.ColorIndex = 44
            End With
        End With
        .Activate
    End With
    Application.ScreenUpdating = True
End Sub

klin89

 

[didinelfange]

Re : Faire un tableau récapitulaitif par utilisateur

Bonjour tout le monde,

Et merci à tous pour votre aide ma macro marche .