Tri de données avec conditions

Le 21/05/2015 à 17:47

Bonjour à tous !

J'ai un petit défi à vous proposer car je sèche sur une manière facile et rapide de trier des données et de les résumer.

Je sais qu'un tableau croisé dynamique aurait pu convenir, mais je préférerai un fichier utilisant une macro car ça me permettrait de retravailler les résultats, mais je ne maîtrise pas du tout les macros d'où mon appel à votre aide.

Je vous explique... ci-joint un fichier excel qui reprend des infos sur des occupations de salles avec les dates (colonne B), les noms (colonne K), le revenu (colonne O), le numéro d'identification du dossier (colonne AA), le numéro de l'événement (colonne AG).

En résumé, pour un dossier, il peut y avoir plusieurs événements (pour cet exemple, je n'ai pris qu'un seul dossier avec tous ses événements mais je suis amené a traiter des fichiers avec des centaines de dossiers et donc des milliers d'événements).

Le but recherché serait de pouvoir avoir le revenu généré par chaque salle, pour chaque jour, pour chaque dossier.

Le format du rapport sera toujours pareil, les noms des salles seront toujours identiques au format qui est en colonne K, mais j'aimerai si possible pouvoir en ajouter ultérieurement et que le fichier s'adapte à la modif, donc si la solution passe par une macro, il faudrait qu'il y ait un onglet de paramétrage qui pourrait être modifié sans la faire planter.

Je pense qu'il faudrait utiliser la référence de l'événement (colonne AG), combinée avec le nom de la salle (colonne K), le numéro d'identification du dossier (colonne AA) et avec la date; et que ça donne le revenu.

Dans le deuxième onglet du fichier, un exemple de ce que j'imagine comme résultat après que la macro ait tourné... mais si vous voyez une autre présentation des résultats encore meilleure, je suis preneur.

Un énorme merci d'avance pour votre aide et j'attends vos retours avec impatience !

Dom

9test-forum.xlsx (69.96 Ko)
Le 21/05/2015 à 17:52

bonjour

(entre () : pourquoi refuser un TCD ? que veut dire "retravailler les résultats" ? connais-tu SOMMEPROD() ? )

Le 21/05/2015 à 21:23

Bonjour JMD, merci pour ta réponse. Je ne refuse pas un TCD, je préfèrerai un fichier excel sans filtre ou case à cocher pour choisir tel ou tel critère. Et pour sommeprod, non je ne suis pas familier avec cette formule. Comment pourrais-tu utiliser cette formule dans mon cas ?

Le 22/05/2015 à 07:34

re

tu es bien obligé d'avoir un filtre ou case à cocher ???

SOMMEPROD() permet d'extraire les données d'une table selon quasiment tous les critères que tu veux

(un peu comme les totaux que tu as dans un TCD)

fais un template un tableau plus simple (le tien est trop compliqué, 2 ou 3 colonnes suffisent pour un test), et en feuille 2 un projet de ton besoin

Le 25/05/2015 à 18:04

Bonjour jmd, dombal, le forum

A tester.

Une présentation différente, résultat en Feuil1.

Option Explicit

Sub test()
Dim dico As Object, i As Long, n As Long, m As Long, e, s, p
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    With Sheets(1).Cells(1, 2).CurrentRegion
        For i = 2 To .Rows.Count
            If Not dico.exists(.Cells(i, 10).Value) Then
                Set dico(.Cells(i, 10).Value) = _
                CreateObject("Scripting.Dictionary")
                dico(.Cells(i, 10).Value).CompareMode = 1
            End If
            If Not dico(.Cells(i, 10).Value).exists(.Cells(i, 1).Value) Then
                Set dico(.Cells(i, 10).Value)(.Cells(i, 1).Value) = _
                CreateObject("Scripting.Dictionary")
                dico(.Cells(i, 10).Value)(.Cells(i, 1).Value).CompareMode = 1
            End If
            If Not dico(.Cells(i, 10).Value)(.Cells(i, 1).Value).exists(.Cells(i, 26).Value) Then
                Set dico(.Cells(i, 10).Value)(.Cells(i, 1).Value)(.Cells(i, 26).Value) = Union(Union(.Cells(1, 26), .Cells(1, 14), .Cells(1, 32)), Union(.Cells(i, 26), .Cells(i, 14), .Cells(i, 32)))
            Else
                Set dico(.Cells(i, 10).Value)(.Cells(i, 1).Value)(.Cells(i, 26).Value) = Union(dico(.Cells(i, 10).Value)(.Cells(i, 1).Value)(.Cells(i, 26).Value), Union(.Cells(i, 26), .Cells(i, 14), .Cells(i, 32)))
            End If
        Next
    End With
    Application.ScreenUpdating = False
    With Sheets("Feuil1")
        .Rows("3:" & Rows.Count).Delete: n = 3
        For Each e In dico
            With .Cells(n, 1).Resize(, 3)
                .Merge
                .HorizontalAlignment = xlCenter
                .Value = e
                With .Font
                    .Bold = True
                    .Size = 14
                End With
            End With
            For Each s In dico(e)
                n = n + 2
                With .Cells(n, 1)
                    .Value = s
                    .Interior.ColorIndex = 19
                    .BorderAround Weight:=xlThin
                End With
                For Each p In dico(e)(s)
                    n = n + 1: m = n
                    dico(e)(s)(p).Copy .Cells(n, 1)
                    n = n + dico(e)(s)(p).Count / 3 - 1
                    With .Range(.Cells(m + 1, 1), .Cells(n, 3))
                        .BorderAround Weight:=xlThin
                        .Interior.ColorIndex = xlNone
                        With .Offset(.Rows.Count).Resize(1).Columns("a:c")
                            .Interior.ColorIndex = 15
                            .Value = _
                            Array("=sum(r" & m + 1 & "c:r" & n & "c)", p, "=counta(r" & m + 1 & "c:r" & n & "c)")
                        End With
                    End With
                    With .Cells(n, 1).CurrentRegion
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlCenter
                    End With
                    With .Range(.Cells(m, 1), .Cells(n + 1, 3))
                        .Font.Size = 10
                        .BorderAround Weight:=xlThin
                        .Borders(xlInsideVertical).Weight = xlThin
                    End With
                    With .Range(.Cells(m, 1), .Cells(m, 3))
                        .Interior.ColorIndex = 40
                    End With
                    .Range(.Cells(m + 1, 1), .Cells(n + 1, 1)).NumberFormat = "#,##0.00"
                    n = n + 2
                Next
                n = n - 1
            Next
            n = n + 2
        Next
        .Range("a1").EntireColumn.ColumnWidth = 25
        .Range("b1:c1").EntireColumn.ColumnWidth = 15
        .Rows.AutoFit
        .Activate
    End With
    Application.ScreenUpdating = False
End Sub

klin89

4dombal1.zip (27.10 Ko)
Le 25/05/2015 à 19:50

Bonjour Klin89 et merci pour ton post. J'ai testé ta macro et c'est pas mal du tout, ça correspond bien dans l'ensemble à ce que je recherchais !! Par contre en y regardant de plus près, j'ai remarqué que les infos ne sont pas cohérentes car la base de données est assez mal fichue. En fait si on prend comme exemple la journée du 24 janvier pour la salle Foyer Scene A, il y a 4 événements pour un seul book ID, et le revenu de 5705,77 est multiplié par 4, alors que le revenu généré par ces 4 events au total devrait être de 5705,77. En fait, il faudrait adapter la formule pour que les revenus pris en compte soient ceux de la colonne AQ (dont la somme des revenus des 4 événements est bien de 5705,77) et non ceux de la colonne O qui en fait reprend le revenue total de la journée pour chaque ligne d'événement.

Ta présentation est sympa mais j'ai peur que vu le nombre de données que je vais devoir traiter, ça ne soit vite confus dans la lecture. Est-ce que tu penses pouvoir adapter ta macro pour que la présentation se rapproche de l'exemple en sheet 2 ?

En tout cas merci pour le temps que tu as accordé à mon problème, c'est super sympa.

Bonne fin de weekend !

Le 25/05/2015 à 21:29

Re dombal,

J'ai réajusté le code en m'appuyant sur la colonne AQ, restitution en Feuil1 :

Attention, pour les tests, j'ai modifié quelques références de dossier en colonne AA, donc tes totaux sont différents de ceux attendus. 

Option Explicit

Sub test()
Dim dico As Object, i As Long, n As Long, m As Long, e, s, p
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    With Sheets(1).Cells(1, 2).CurrentRegion
        For i = 2 To .Rows.Count
            If Not dico.exists(.Cells(i, 10).Value) Then
                Set dico(.Cells(i, 10).Value) = _
                CreateObject("Scripting.Dictionary")
                dico(.Cells(i, 10).Value).CompareMode = 1
            End If
            If Not dico(.Cells(i, 10).Value).exists(.Cells(i, 1).Value) Then
                Set dico(.Cells(i, 10).Value)(.Cells(i, 1).Value) = _
                CreateObject("Scripting.Dictionary")
                dico(.Cells(i, 10).Value)(.Cells(i, 1).Value).CompareMode = 1
            End If
            If Not dico(.Cells(i, 10).Value)(.Cells(i, 1).Value).exists(.Cells(i, 26).Value) Then
                Set dico(.Cells(i, 10).Value)(.Cells(i, 1).Value)(.Cells(i, 26).Value) = Union(Union(.Cells(1, 26), .Cells(1, 32), .Cells(1, 42)), Union(.Cells(i, 26), .Cells(i, 32), .Cells(i, 42)))
            Else
                Set dico(.Cells(i, 10).Value)(.Cells(i, 1).Value)(.Cells(i, 26).Value) = Union(dico(.Cells(i, 10).Value)(.Cells(i, 1).Value)(.Cells(i, 26).Value), Union(.Cells(i, 26), .Cells(i, 32), .Cells(i, 42)))
            End If
        Next
    End With
    Application.ScreenUpdating = False
    With Sheets("Feuil1")
        .Rows("3:" & Rows.Count).Delete: n = 3
        For Each e In dico
            With .Cells(n, 1).Resize(, 3)
                .Merge
                .HorizontalAlignment = xlCenter
                .Value = e
                With .Font
                    .Bold = True
                    .Size = 14
                End With
            End With
            For Each s In dico(e)
                n = n + 2
                With .Cells(n, 1)
                    .Value = s
                    .Interior.ColorIndex = 19
                    .BorderAround Weight:=xlThin
                End With
                For Each p In dico(e)(s)
                    n = n + 1: m = n
                    dico(e)(s)(p).Copy .Cells(n, 1)
                    n = n + dico(e)(s)(p).Count / 3 - 1
                    With .Range(.Cells(m + 1, 1), .Cells(n, 3))
                        .BorderAround Weight:=xlThin
                        .Interior.ColorIndex = xlNone
                        With .Offset(.Rows.Count).Resize(1).Columns("a:c")
                            .Interior.ColorIndex = 15
                            .Value = _
                            Array(p, "=counta(r" & m + 1 & "c:r" & n & "c)", "=sum(r" & m + 1 & "c:r" & n & "c)")
                        End With
                    End With
                    With .Cells(n, 1).CurrentRegion
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlCenter
                    End With
                    With .Range(.Cells(m, 1), .Cells(n + 1, 3))
                        .Font.Size = 10
                        .BorderAround Weight:=xlThin
                        .Borders(xlInsideVertical).Weight = xlThin
                    End With
                    With .Range(.Cells(m, 1), .Cells(m, 3))
                        .Interior.ColorIndex = 40
                    End With
                    .Range(.Cells(m + 1, 3), .Cells(n + 1, 3)).NumberFormat = "#,##0.00"
                    n = n + 2
                Next
                n = n - 1
            Next
            n = n + 2
        Next
        .Range("a1:c1").EntireColumn.ColumnWidth = 22
        .Rows.AutoFit
        .Activate
    End With
    Application.ScreenUpdating = False
End Sub
4dombal2.zip (27.18 Ko)

klin89

Le 25/05/2015 à 22:21

Merci klin89 pour ta réactivité et la modification apportée à la macro. C'est super, ça va vraiment m'aider. Je vais faire des tests et je te tiens au courant ! Encore Merci pour ton temps ! Bonne soirée

Rechercher des sujets similaires à "tri donnees conditions"