Résultat de tableau croisé dynamique par macro

**tools** · 20/08/2012, 16h51

Bonjour à tous!

Rémi, je suis étudiant et je cherche à faire une macro qui syntétiserai un tableau de données.
Débutant dans le langage VBA, mes quelques notions m'ont permis de mettre au point une petite boucle mais qui malheuresement ne donne pas le resultat éscompté.
Après plusieurs essais, recherches et modifications je me voit renoncer et donc me diriger vers ce forum où j'en suis sur, sont présents de nombreuses personnes qui ont les compétences que je n'ai pas.

D'avance merci de m'aider.

Dans le fichier ci-joint vous trouverai mon travail (pas glorieux me direz-vous), ainsi que la BASE et le RESULTAT voulu, obtenu grace à un tableau croisé dynamique.

J'éspère avoir été bref, clair et concis.

Bien cordialement.

D'avance merci.

Rémi

**Daniel.C** · 20/08/2012, 17h25

Bonjour,

Je ne comprends pas ce que tu veux faire par macro alors que le TCD est déjà construit.
PS. Précise ta version d'Excel, c'est important pour les TCD.

**tools** · 21/08/2012, 10h45

Bonjour,

Tout d'abords, merci de me venir en aide.
Je travaille sur office 2007 et office 2003.
Le but de ma macro ne serait pas de construire un TCD mais au contraire d'obtenir le même résultat grâce à la macro.

J'ai une feuille BASE où j'ai mes données, et je souhaiterai obtenir le résultat dans la feuille TempsMOD.
Je voudrais la somme de mes temps "Typ de sal" = 309 en fonction du nom, prénom et de la date.

J'ai ajouté plus de détails dans mon classeur.

En espérant m'être mieux expliqué.

Bien cordialement

D'avance merci.

Rémi

**Daniel.C** · 21/08/2012, 13h09

Essaie cette macro :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Sub test()
    Dim Sh As Worksheet, Dico As Object, C As Range, Ligne As Long, Plage As Range
    Dim DicoDates As Object, X As Range, Plage2 As Range
    Ligne = 1
    Set Sh = Sheets("TempsMOD")
    With Sheets("TempsMOD")
        .Range(.[A2], .Cells(.Rows.Count, 4).End(xlUp)).ClearContents
    End With
    With Sheets("BASE")
        Set Dico = CreateObject("Scripting.Dictionary")
        Set DicoDates = CreateObject("Scripting.Dictionary")
        Set Plage = .Range(.[C5], .Cells(.Rows.Count, 3).End(xlUp)).Resize(, 16)
        For Each C In .Range(.[C6], .Cells(.Rows.Count, 3).End(xlUp))
            If Not Dico.exists(C.Value) And C.Value <> "" Then
                Dico.Add C.Value, C.Value
                .AutoFilterMode = False
                Set Plage = .Range(.[C5], .Cells(.Rows.Count, 3).End(xlUp)).Resize(, 16)
                Plage.AutoFilter 1, C.Value
                Plage.AutoFilter 14, 309
                Set Plage = Plage.Offset(1).Resize(Plage.Rows.Count - 1)
                If Application.Subtotal(103, Plage) > 0 Then
                    Set Plage = Plage.SpecialCells(xlCellTypeVisible)
                    DicoDates.RemoveAll
                    Set Plage2 = .AutoFilter.Range.Resize(, 1).Offset(1, 12)
                    Set Plage2 = Plage2.Resize(Plage2.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
                    For Each X In Plage2
                        If Not DicoDates.exists(X.Value) Then
                            DicoDates.Add X.Value, X.Value
                            Plage.AutoFilter 13, X.Value
                            Ligne = Ligne + 1
                            Sh.Cells(Ligne, 1) = C.Offset(, 1)
                            Sh.Cells(Ligne, 2) = C.Offset(, 2)
                            Sh.Cells(Ligne, 3) = X.Value
                            Sh.Cells(Ligne, 4) = Application.Subtotal(109, .Columns(19))
                        End If
                    Next X
                End If
                .AutoFilterMode = False
            End If
        Next C
    End With
    With Sheets("TempsMOD")
    .Range(.[A1], .Cells(.Rows.Count, 4).End(xlUp)).Range(.[A1], .Cells(.Rows.Count, 4).End(xlUp)).Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
        , Order2:=xlAscending, Key3:=Range("D2"), Order3:=xlAscending, Header:=xlGuess
    End With
End Sub

**tools** · 21/08/2012, 14h28

Daniel,

Merci pour votre aide.

Effectivement la macro à l'air de fonctionner.
Cependant du à une petite erreur de coordonée de ma part dans le dossier que je vous ai envoyé, lorsque je met le code dans mon classeur de travail, le code ne fonctionne point.
Ne comprenend pas votre code pour l'adapter, je me retourne une nouvelle et dérnière fois je pense pour votre soutient.

Un grand merci.
Bien cordialement.

Rémi

**Daniel.C** · 21/08/2012, 14h58

C'est pas sympa d'avoir changé la disposition des données sur la feuille BASE.

Je vais mettre des commentaires. Pour te permettre de l'utiliser tout de suite :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Sub test()
    Dim Sh As Worksheet, Dico As Object, C As Range, Ligne As Long, Plage As Range
    Dim DicoDates As Object, X As Range, Plage2 As Range
    Application.ScreenUpdating = False
    Ligne = 1
    Set Sh = Sheets("TempsMOD")
    With Sheets("TempsMOD")
        .Range(.[A2], .Cells(.Rows.Count, 4).End(xlUp)).ClearContents
    End With
    With Sheets("BASE")
        Set Dico = CreateObject("Scripting.Dictionary")
        Set DicoDates = CreateObject("Scripting.Dictionary")
        Set Plage = .Range(.[C5], .Cells(.Rows.Count, 3).End(xlUp)).Resize(, 18)
        'Plage.Select
        For Each C In .Range(.[C6], .Cells(.Rows.Count, 3).End(xlUp))
            If Not Dico.exists(C.Value) And C.Value <> "" Then
                Dico.Add C.Value, C.Value
                .AutoFilterMode = False
                Set Plage = .Range(.[C5], .Cells(.Rows.Count, 3).End(xlUp)).Resize(, 18)
                Plage.AutoFilter 1, C.Value
                Plage.AutoFilter 15, 309
                Set Plage = Plage.Offset(1).Resize(Plage.Rows.Count - 1)
                If Application.Subtotal(103, Plage) > 0 Then
                    Set Plage = Plage.SpecialCells(xlCellTypeVisible)
                    DicoDates.RemoveAll
                    Set Plage2 = .AutoFilter.Range.Resize(, 1).Offset(1, 13)
                    Set Plage2 = Plage2.Resize(Plage2.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
                    For Each X In Plage2
                        If Not DicoDates.exists(X.Value) Then
                            DicoDates.Add X.Value, X.Value
                            Plage.AutoFilter 14, X.Value
                            Ligne = Ligne + 1
                            Sh.Cells(Ligne, 1) = C.Offset(, 2)
                            Sh.Cells(Ligne, 2) = C.Offset(, 3)
                            Sh.Cells(Ligne, 3) = X.Value
                            Sh.Cells(Ligne, 4) = Application.Subtotal(109, .Columns(20))
                        End If
                    Next X
                End If
                .AutoFilterMode = False
            End If
        Next C
    End With
    Application.ScreenUpdating = True
End Sub

La même, commentée :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
Sub test()
    Dim Sh As Worksheet, Dico As Object, C As Range, Ligne As Long, Plage As Range
    Dim DicoDates As Object, X As Range, Plage2 As Range
    'on stoppe le rafraichissement de l'écran pour gagner en performance
    'et pour pas avoir mal aux yeux
    Application.ScreenUpdating = False
    Ligne = 1
    Set Sh = Sheets("TempsMOD")
    'effacement de la feuille TempsMOD (sauf les entêtes)
    With Sheets("TempsMOD")
        .Range(.[A2], .Cells(.Rows.Count, 4).End(xlUp)).ClearContents
    End With
    With Sheets("BASE")
        'création d'un dictionnaire pour élimination les doublons sur le matricule
        Set Dico = CreateObject("Scripting.Dictionary")
        'création d'un dictionnaire pour élimination les doublons sur les dates
        Set DicoDates = CreateObject("Scripting.Dictionary")
        'définition de "Plage" en tant que l'ensemble des données de la feuille BASE
        Set Plage = .Range(.[C5], .Cells(.Rows.Count, 3).End(xlUp)).Resize(, 18)
        'boucle sur la colonne "Matricule"
        For Each C In .Range(.[C6], .Cells(.Rows.Count, 3).End(xlUp))
            'si la valeur n'est pas dans le dictionnaire (première fois qu'on la rencontre)
            'et qu'elle n'est pas nulle
            If Not Dico.exists(C.Value) And C.Value <> "" Then
                'on la traite
                'on l'ajoute au dictionnaire
                Dico.Add C.Value, C.Value
                'on supprime le filtre
                .AutoFilterMode = False
                'on définit la plage à filtrer
                Set Plage = .Range(.[C5], .Cells(.Rows.Count, 3).End(xlUp)).Resize(, 18)
                'on filtre le premier champ sur la valeur en cours du mtricule
                Plage.AutoFilter 1, C.Value
                'on filtre le 15e champ sur la valeur 309
                Plage.AutoFilter 15, 309
                'on redéfinit la plage en ôtant les entêtes
                Set Plage = Plage.Offset(1).Resize(Plage.Rows.Count - 1)
                's'il y a des cellules visibles (quelque chose de filtré)
                If Application.Subtotal(103, Plage) > 0 Then
                    'on redéfinit la plage en la liitant aux cellules visibles
                    Set Plage = Plage.SpecialCells(xlCellTypeVisible)
                    'on efface le dico des dates
                    DicoDates.RemoveAll
                    'on définit "Plage2" comme la plage des dates visibles
                    Set Plage2 = .AutoFilter.Range.Resize(, 1).Offset(1, 13)
                    Set Plage2 = Plage2.Resize(Plage2.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
                    'on boucle dans ces dates
                    For Each X In Plage2
                        'si la date n'est pas présente dans la dictiionnaire des dates
                        If Not DicoDates.exists(X.Value) Then
                            'on l'y ajoute
                            DicoDates.Add X.Value, X.Value
                            'on filtre la colonne des dates sur cette valeur
                            Plage.AutoFilter 14, X.Value
                            'Ecriture sur la feuille TempsMOD
                            Ligne = Ligne + 1
                            'du nom
                            Sh.Cells(Ligne, 1) = C.Offset(, 2)
                            'du prénom
                            Sh.Cells(Ligne, 2) = C.Offset(, 3)
                            'de la date
                            Sh.Cells(Ligne, 3) = X.Value
                            'en colonne D on fait la somme des cellules visibles de la colonne T
                            Sh.Cells(Ligne, 4) = Application.Subtotal(109, .Columns(20))
                        End If
                    Next X
                End If
                .AutoFilterMode = False
            End If
        Next C
    End With
    Application.ScreenUpdating = True
End Sub

**tools** · 21/08/2012, 18h05

Daniel,

Merci de votre aide ainsi que de vos commentaires qui m'ont permis de comprendre (plus ou moins) la façon réalisé.
Cela m'a aussi permis d'optimiser d'autres codes.

Une fois de plus un grand merci pour la réactivité ainsi que la solution à mon problème.

Bien cordialement

Rémi

Résultat de tableau croisé dynamique par macro [Toutes versions]

Macros et VBA Excel

Discussions similaires

Partager

Partager