Organiser des données dans un tableau

Le 19/05/2017 à 12:01

Bonjour, je dois organiser des données mais je ne sais pas cmt m'y prendre. Je veux créer un tableau croisé dynamique. j'ai une liste d'utilisateurs et une liste d'applications. Chaque utilisateur m'a fourni sa liste d'application qu'il utilise. Je dois veux créer un tableau ou je pourrai faire des filtres par application et par utilisateur. Par exemple si je filtre sur Application 1 (A1) seuls les utilisateurs qui l'utilise apparaitront ou à l'inverse, si je clique sur l'utilisateur 1 (U1) seuls les applications qu'il utilise apparaitront. Pouriez vous m'aider à créer ce tableau ? Je dois pouvoir choisir plusieurs configurations pour créer des graphiques. Merci pour votre retour.

25exemple-de-donnees.xlsx (10.04 Ko)
Le 19/05/2017 à 12:15

Salut Nasck,

Pour le bien du forum, pourrais-tu poster un fichier anonyme stp?

Cordialement

Le 19/05/2017 à 14:38

J'ai inséré un petit exemple. Merci

Le 19/05/2017 à 14:52

A première vu ton fichier est tellement étaler un peu partout on ne sait pas ce que l'on doit utiliser, tu as un tableau à droite ou il y a U6 mais à gauche non..

Cordialement,

Le 19/05/2017 à 15:31

Ok j'explique; la il ne s'agit que d'un exemple mais en réalité, j'ai une centaine d'appllications et une centaines d'utilisateurs; La question qui a été posée aux utilisateurs est : quelles applications utilisez-vous ? J'ai recueilli les réponses dans le tableau retour des utilisateurs. Maintenant je voudrais créer un seul tableau ou j'aurais le retour des utilisateurs, la liste des applis et la liste des utilisateurs et je pourrai appliquer des filtres pour afficher la liste de tous les utilisateurs qui utilisent une application particulière ou la listes des applications utilisées par un utilisateur particulier (un tableau croisé dynamique je pense)

PS :pour U6, j'ai oublié de le rajouter dans la liste des Users)

Le 20/05/2017 à 14:15

Bonjour,

Personne pour m'aider à construire ce tableau?

Le 21/05/2017 à 16:07

bonjour

si Tulipe le Bon ne t'abandonne pas ; mais c'est Dimanche

18ulucas.xlsx (11.24 Ko)

cordialement

Le 21/05/2017 à 16:30
tulipe_4 a écrit :

bonjour

si Tulipe le Bon ne t'abandonne pas ; mais c'est Dimanche

cordialement

Merci tulipe_4 pour ta réponse, peux-tu m'expliquer tes formules ? ce n'est pas sous forme de tableau et du coup j'ai pas les filtres.

Le 21/05/2017 à 18:31

re

donc

la formule (la seule) va a la peche de ce qui est present dans ton tablo "source" en fonction des 2 critères "appli" et utilisateur

si il y correspondance cela renvoie 1 et si cela renvoie 1 le SI de depart le convertit en "X"

pour revenir au tablo automatique (beurk!!!) tu selectionnes ce tablo puis >>>insertion >>>>tableau ;il va t'etre demandé si ce dernier comporte des entete >>>ok

cordialement

Le 21/05/2017 à 20:05

Bonsoir à tous,

Restitution en feuil2

Option Explicit
Sub test()
Dim b(), i As Long, j As Long, r As Range
Dim dico1 As Object, dico2 As Object
    Set dico1 = CreateObject("Scripting.Dictionary")
    dico1.CompareMode = 1
    Set dico2 = CreateObject("Scripting.Dictionary")
    dico2.CompareMode = 1
    With Sheets("Feuil1")
        'Liste des Applis
        For Each r In .Range("a2", .Range("a" & Rows.Count).End(xlUp))
            dico1(r.Value) = dico1.Count + 2
        Next
        'Liste des users
        For Each r In .Range("d2", .Range("d" & Rows.Count).End(xlUp))
            dico2(r.Value) = dico2.Count + 2
        Next
        ReDim b(1 To dico1.Count + 1, 1 To dico2.Count + 1)
        b(1, 1) = "Liste des applis"
        For i = 0 To dico1.Count - 1
            b(i + 2, 1) = dico1.keys()(i)
        Next
        For i = 0 To dico2.Count - 1
            b(1, i + 2) = dico2.keys()(i)
        Next
        'Retour des users
        With .Range("g1").CurrentRegion
            For i = 3 To .Rows.Count
                For j = 1 To .Columns.Count
                    If .Cells(i, j).Value <> "" Then
                        b(dico1.Item(.Cells(i, j).Value), dico2.Item(.Cells(2, j).Value)) = "x"
                    End If
                Next
            Next
        End With
    End With
    'Restitution
    Application.ScreenUpdating = False
    With Sheets("Feuil2").Range("a1")
        .CurrentRegion.Cells.Clear
        With .Resize(UBound(b, 1), UBound(b, 2))
            .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
                With .Offset(, 1).Resize(, .Columns.Count - 1)
                    .Interior.ColorIndex = 40
                End With
            End With
            With .Columns(1)
                .Columns.ColumnWidth = 16
                With .Offset(1).Resize(.Rows.Count - 1)
                    .Interior.ColorIndex = 36
                End With
            End With
        End With
    End With
    Set dico1 = Nothing
    Set dico2 = Nothing
    Application.ScreenUpdating = True
End Sub

klin89

Le 22/05/2017 à 18:50
Klin89 a écrit :

Bonsoir à tous,

Restitution en feuil2

Option Explicit
Sub test()
Dim b(), i As Long, j As Long, r As Range
Dim dico1 As Object, dico2 As Object
    Set dico1 = CreateObject("Scripting.Dictionary")
    dico1.CompareMode = 1
    Set dico2 = CreateObject("Scripting.Dictionary")
    dico2.CompareMode = 1
    With Sheets("Feuil1")
        'Liste des Applis
        For Each r In .Range("a2", .Range("a" & Rows.Count).End(xlUp))
            dico1(r.Value) = dico1.Count + 2
        Next
        'Liste des users
        For Each r In .Range("d2", .Range("d" & Rows.Count).End(xlUp))
            dico2(r.Value) = dico2.Count + 2
        Next
        ReDim b(1 To dico1.Count + 1, 1 To dico2.Count + 1)
        b(1, 1) = "Liste des applis"
        For i = 0 To dico1.Count - 1
            b(i + 2, 1) = dico1.keys()(i)
        Next
        For i = 0 To dico2.Count - 1
            b(1, i + 2) = dico2.keys()(i)
        Next
        'Retour des users
        With .Range("g1").CurrentRegion
            For i = 3 To .Rows.Count
                For j = 1 To .Columns.Count
                    If .Cells(i, j).Value <> "" Then
                        b(dico1.Item(.Cells(i, j).Value), dico2.Item(.Cells(2, j).Value)) = "x"
                    End If
                Next
            Next
        End With
    End With
    'Restitution
    Application.ScreenUpdating = False
    With Sheets("Feuil2").Range("a1")
        .CurrentRegion.Cells.Clear
        With .Resize(UBound(b, 1), UBound(b, 2))
            .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
                With .Offset(, 1).Resize(, .Columns.Count - 1)
                    .Interior.ColorIndex = 40
                End With
            End With
            With .Columns(1)
                .Columns.ColumnWidth = 16
                With .Offset(1).Resize(.Rows.Count - 1)
                    .Interior.ColorIndex = 36
                End With
            End With
        End With
    End With
    Set dico1 = Nothing
    Set dico2 = Nothing
    Application.ScreenUpdating = True
End Sub

klin89

Merci pour ta réponse klin89, je suppose que c'est un code VBA; je suis novice en VBA peux tu me dire cmt l'utiliser; ce n'est pas trop compliquée pour mon exemple; j'ai peur de ne pas pouvoir reproduire quand il y aura des modifications à faire.

Klin89 a écrit :

Bonsoir à tous,

Restitution en feuil2

Option Explicit
Sub test()
Dim b(), i As Long, j As Long, r As Range
Dim dico1 As Object, dico2 As Object
    Set dico1 = CreateObject("Scripting.Dictionary")
    dico1.CompareMode = 1
    Set dico2 = CreateObject("Scripting.Dictionary")
    dico2.CompareMode = 1
    With Sheets("Feuil1")
        'Liste des Applis
        For Each r In .Range("a2", .Range("a" & Rows.Count).End(xlUp))
            dico1(r.Value) = dico1.Count + 2
        Next
        'Liste des users
        For Each r In .Range("d2", .Range("d" & Rows.Count).End(xlUp))
            dico2(r.Value) = dico2.Count + 2
        Next
        ReDim b(1 To dico1.Count + 1, 1 To dico2.Count + 1)
        b(1, 1) = "Liste des applis"
        For i = 0 To dico1.Count - 1
            b(i + 2, 1) = dico1.keys()(i)
        Next
        For i = 0 To dico2.Count - 1
            b(1, i + 2) = dico2.keys()(i)
        Next
        'Retour des users
        With .Range("g1").CurrentRegion
            For i = 3 To .Rows.Count
                For j = 1 To .Columns.Count
                    If .Cells(i, j).Value <> "" Then
                        b(dico1.Item(.Cells(i, j).Value), dico2.Item(.Cells(2, j).Value)) = "x"
                    End If
                Next
            Next
        End With
    End With
    'Restitution
    Application.ScreenUpdating = False
    With Sheets("Feuil2").Range("a1")
        .CurrentRegion.Cells.Clear
        With .Resize(UBound(b, 1), UBound(b, 2))
            .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
                With .Offset(, 1).Resize(, .Columns.Count - 1)
                    .Interior.ColorIndex = 40
                End With
            End With
            With .Columns(1)
                .Columns.ColumnWidth = 16
                With .Offset(1).Resize(.Rows.Count - 1)
                    .Interior.ColorIndex = 36
                End With
            End With
        End With
    End With
    Set dico1 = Nothing
    Set dico2 = Nothing
    Application.ScreenUpdating = True
End Sub

klin89

tulipe_4 a écrit :

re

donc

la formule (la seule) va a la peche de ce qui est present dans ton tablo "source" en fonction des 2 critères "appli" et utilisateur

si il y correspondance cela renvoie 1 et si cela renvoie 1 le SI de depart le convertit en "X"

pour revenir au tablo automatique (beurk!!!) tu selectionnes ce tablo puis >>>insertion >>>>tableau ;il va t'etre demandé si ce dernier comporte des entete >>>ok

cordialement

Merci, j'ai de créer les tableaux automatiques (prk beurk lol), j'arrive à faire les filtres par application mais pas par utilisateurs cmt faire pour avoir un filtre par utilisateurs.

Le 22/05/2017 à 19:08

bonjour

ça ne doit pas etre possible ; mais si je comprend bien tu desirerai plutot avoir une extaction par utilisateur

peux tu confirmer ?

cordialement

Le 23/05/2017 à 14:35
14utilisateurs.xlsx (42.13 Ko)

Voici un nouveau doc qui explique mieux le résultat que je souhaite obtenir.

tulipe_4 a écrit :

bonjour

ça ne doit pas etre possible ; mais si je comprend bien tu desirerai plutot avoir une extaction par utilisateur

peux tu confirmer ?

cordialement

Bonjour, je viens de poster un nouvel exemple. Merci

Le 23/05/2017 à 20:50

Re Nasck

A tester avec le 1er fichier

Option Explicit
Sub test()
Dim b(), i As Long, j As Long, r As Range
Dim dico1 As Object, dico2 As Object
    Set dico1 = CreateObject("Scripting.Dictionary")
    dico1.CompareMode = 1
    Set dico2 = CreateObject("Scripting.Dictionary")
    dico2.CompareMode = 1
    With Sheets("Feuil1")
        'Liste des users
        For Each r In .Range("d2", .Range("d" & Rows.Count).End(xlUp))
            dico1(r.Value) = dico1.Count + 2
        Next
        'Liste des Applis
        For Each r In .Range("a2", .Range("a" & Rows.Count).End(xlUp))
            dico2(r.Value) = dico2.Count + 2
        Next
        ReDim b(1 To dico1.Count + 2, 1 To dico2.Count + 2)
        b(1, 1) = "Utilisateurs"
        b(1, UBound(b, 2)) = "Total applis"
        b(UBound(b, 1), 1) = "Total users"
        For i = 0 To dico1.Count - 1
            b(i + 2, 1) = dico1.keys()(i)
        Next
        For i = 0 To dico2.Count - 1
            b(1, i + 2) = dico2.keys()(i)
        Next
        'Retour des users
        With .Range("g1").CurrentRegion
            For i = 3 To .Rows.Count
                For j = 1 To .Columns.Count
                    If .Cells(i, j).Value <> "" Then
                        b(dico1.Item(.Cells(2, j).Value), dico2.Item(.Cells(i, j).Value)) = "x"
                    End If
                Next
            Next
        End With
    End With
    For i = 2 To UBound(b, 2) - 1
        b(UBound(b, 1), i) = _
        Application.CountA(Application.Index(b, Evaluate("row(2:" & UBound(b, 1) - 1 & ")"), i))
    Next
    For i = 2 To UBound(b, 1) - 1
        b(i, UBound(b, 2)) = _
        Application.CountA(Application.Index(b, i, Evaluate("row(2:" & UBound(b, 2) - 1 & ")")))
    Next
    b(UBound(b, 1), UBound(b, 2)) = _
    Application.Sum(Application.Index(b, UBound(b, 1), Evaluate("row(2:" & UBound(b, 2) - 1 & ")")))

    Application.ScreenUpdating = False
    With Sheets("Feuil2").Range("a1")
        .CurrentRegion.Cells.Clear
        With .Resize(UBound(b, 1), UBound(b, 2))
            .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
                With .Offset(, 1).Resize(, .Columns.Count - 2)
                    .Interior.ColorIndex = 40
                End With
            End With
            With .Rows(.Rows.Count)
                .BorderAround Weight:=xlThin
                With .Offset(, 1).Resize(, .Columns.Count - 2)
                    .Interior.ColorIndex = 15
                End With
            End With
            With .Columns(1)
                .Columns.ColumnWidth = 16
                With .Offset(1).Resize(.Rows.Count - 2)
                    .Interior.ColorIndex = 36
                End With
            End With
            With .Columns(.Columns.Count)
                .Columns.ColumnWidth = 12
                With .Offset(1).Resize(.Rows.Count - 2)
                    .Interior.ColorIndex = 36
                End With
            End With
        End With
    End With
    Set dico1 = Nothing
    Set dico2 = Nothing
    Application.ScreenUpdating = True
End Sub

klin89

Le 01/06/2017 à 16:31
Klin89 a écrit :

Re Nasck

A tester avec le 1er fichier

Option Explicit
Sub test()
Dim b(), i As Long, j As Long, r As Range
Dim dico1 As Object, dico2 As Object
    Set dico1 = CreateObject("Scripting.Dictionary")
    dico1.CompareMode = 1
    Set dico2 = CreateObject("Scripting.Dictionary")
    dico2.CompareMode = 1
    With Sheets("Feuil1")
        'Liste des users
        For Each r In .Range("d2", .Range("d" & Rows.Count).End(xlUp))
            dico1(r.Value) = dico1.Count + 2
        Next
        'Liste des Applis
        For Each r In .Range("a2", .Range("a" & Rows.Count).End(xlUp))
            dico2(r.Value) = dico2.Count + 2
        Next
        ReDim b(1 To dico1.Count + 2, 1 To dico2.Count + 2)
        b(1, 1) = "Utilisateurs"
        b(1, UBound(b, 2)) = "Total applis"
        b(UBound(b, 1), 1) = "Total users"
        For i = 0 To dico1.Count - 1
            b(i + 2, 1) = dico1.keys()(i)
        Next
        For i = 0 To dico2.Count - 1
            b(1, i + 2) = dico2.keys()(i)
        Next
        'Retour des users
        With .Range("g1").CurrentRegion
            For i = 3 To .Rows.Count
                For j = 1 To .Columns.Count
                    If .Cells(i, j).Value <> "" Then
                        b(dico1.Item(.Cells(2, j).Value), dico2.Item(.Cells(i, j).Value)) = "x"
                    End If
                Next
            Next
        End With
    End With
    For i = 2 To UBound(b, 2) - 1
        b(UBound(b, 1), i) = _
        Application.CountA(Application.Index(b, Evaluate("row(2:" & UBound(b, 1) - 1 & ")"), i))
    Next
    For i = 2 To UBound(b, 1) - 1
        b(i, UBound(b, 2)) = _
        Application.CountA(Application.Index(b, i, Evaluate("row(2:" & UBound(b, 2) - 1 & ")")))
    Next
    b(UBound(b, 1), UBound(b, 2)) = _
    Application.Sum(Application.Index(b, UBound(b, 1), Evaluate("row(2:" & UBound(b, 2) - 1 & ")")))

    Application.ScreenUpdating = False
    With Sheets("Feuil2").Range("a1")
        .CurrentRegion.Cells.Clear
        With .Resize(UBound(b, 1), UBound(b, 2))
            .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
                With .Offset(, 1).Resize(, .Columns.Count - 2)
                    .Interior.ColorIndex = 40
                End With
            End With
            With .Rows(.Rows.Count)
                .BorderAround Weight:=xlThin
                With .Offset(, 1).Resize(, .Columns.Count - 2)
                    .Interior.ColorIndex = 15
                End With
            End With
            With .Columns(1)
                .Columns.ColumnWidth = 16
                With .Offset(1).Resize(.Rows.Count - 2)
                    .Interior.ColorIndex = 36
                End With
            End With
            With .Columns(.Columns.Count)
                .Columns.ColumnWidth = 12
                With .Offset(1).Resize(.Rows.Count - 2)
                    .Interior.ColorIndex = 36
                End With
            End With
        End With
    End With
    Set dico1 = Nothing
    Set dico2 = Nothing
    Application.ScreenUpdating = True
End Sub

klin89

Super la macro klin89, elle marche bien mais un peu trop compliquée pour une novice comme moi.

Bonjour à tous,

je voudrais remercier chaleureusement tout les membres qui ont pris le temps de me répondre (il y en a meme qui m'ont fait une macro).

j'ai trouvé une solution à mon probème beaucoup plus simple sans passer par les macros (en utilisant un TCD en fait), je vous enverrai un exemple. Merci à tous et vive la communauté.

15exemple-de-donnees.xlsx (14.11 Ko)

Ci-joint la solution. Je la joint pour qu'elle puisse aider ceux qui pourraient avoir les memes problèmes.

Rechercher des sujets similaires à "organiser donnees tableau"