Tableau croisé dynamique sans calcul

**docjo** · 15/08/2013, 10h02

Bonjour à tous

Je cherche à faire un tableau croisé dynamique sans calcul par le code et en cherchant j'ai trouvé une source. Il semble qu'il se soit glissé quelques erreurs dans ces lignes et en outre j'aimerai adapter ce code pour avoir 2 niveaux dans les en têtes de colonne.

Colonne1: identité à mettre en ligne dnas le TCD
Colonne2: Date d'activité à mettre en entete de colonne
Colonne3: Activité à mettre en 2ième niveau d’Entête de colonne
Colonne4: la valeur à faire apparaître sans calcul (sous forme de texte) dans le TCD.

J'essaie de réfléchir sur ce code mais je ne vois pas trop la bonne solution (probablement trop dur pour mes modestes compétences).
Je vous remercie par avance pour votre aide.

**Daniel.C** · 15/08/2013, 11h51

Bonjour,

Je ne sais pas si tu as bien compris ce dont il s'agit. Il ne s'agit pas d'un véritable TCD, mais d'un tableau qui en tient lieu. Maintenant, quand je vois le nom de l'auteur d'une part et le niveau de tes compétences de l'autre, je me dis que tu as sans doute mal compris. Laurent Longre est à ma connaissance le seul francophone qui soit l'auteur d'une macro complémentaire utilisée dans le monde entier. Néanmoins, si tu as trouvé des erreurs, tu peux les mettre en commentaire en dessous du code.

**docjo** · 15/08/2013, 12h10

J'ai bien compris qu'il s'agit d'un TCD qui n'est pas classique et c'est ce que je veux !
Par ailleurs je ne permettrai pas de contredire un développeur du niveau de Mr Longre (et je m'en excuse si je l'ai offensé) mais quand je veux rentrer son code dans la macro, il y a des avertissements en rouge et à la lecture il semble qu'il manque des petites choses.

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
 
Private Sub Recurse(ByVal B1 As Long, ByVal H1 As Long)
 Dim B2 As Long
 Dim H2 As Long
 B2 = B1
 H2 = H1
 Elt = Arr(Idx((B1 + H1) \ 2), 1)
'la ligne suivante est en erreur: 2 Do while  à la suite ? Do While B2 quoi ?
 Do While B2   Do While B2    B2 = B2 + 1
  Loop
  Do While H2 > B1 And Arr(Idx(H2), 1) > Elt
   H2 = H2 - 1
  Loop
' La ligne suivante: If B2 quoi ? Où est then ?
  If B2    IdxTemp = Idx(B2)
   Idx(B2) = Idx(H2)
   Idx(H2) = IdxTemp
  End If
  If B2    B2 = B2 + 1
   H2 = H2 - 1
  End If
 Loop
 If H2 > B1 Then Recurse B1, H2
 If B2  end sub
End Sub

Merci pour vos suggestions

**Daniel.C** · 15/08/2013, 12h22

Tu as raison. Il s'agit d'une erreur à la recopie (il me semble que Laurent a cessé d'intervenir sur les sites depuis la fermeture du sien). Mets un commentaire afin que l'erreur soit rectifiée.

J'ai bien compris qu'il s'agit d'un TCD qui n'est pas classique et c'est ce que je veux !

Ce n'est pas un TCD du tout. C'est un simple tableau, donc pas d'actualisation etc.

Mets un classeur exemple en pièce jointe.

**docjo** · 15/08/2013, 12h49

Voici le fichier excel comprenant les colonnes et le tableau qu'il faudrait que j'obtienne.

Exemple.xlsx

**Daniel.C** · 15/08/2013, 17h05

Regarde ce code. Il faut que tu ajoutes une feuille "Résultat". Les résultats que je trouve sont très différents des tiens, ne serait-ce qu'il y a parfois plus de 4 activités par praticien. Dis-moi quoi.

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 Tableau()
    Dim Plage As Range, C As Range, Dico As Object, Ligne As Long, Col As Integer
    With Sheets("les colonnes")
        Set Plage = .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
        .[I:I].ClearContents
        .[B:B].Copy .[I1]
        .[I:I].Sort .[I1], xlAscending, Header:=xlYes
        Set Dico = CreateObject("Scripting.Dictionary")
        .[I:I].Copy .[B1]
        .[I:I].ClearContents
        i = -2
        For Each C In Plage.Offset(, 1)
            If Not Dico.exists(C.Value) Then
                Dico.Add C.Value, C.Value
            End If
        Next C
    End With
    With Sheets("Résultat")
        .[A2] = "praticien"
        For Each Item In Dico.items
            i = i + 4
            .Cells(1, i).Resize(, 4).Merge
            .Cells(1, i) = Format(Item, "dddd dd mmmm yyyy")
            .Cells(2, i) = "_M"
            .Cells(2, i + 1) = "AM"
            .Cells(2, i + 2) = "N1"
            .Cells(2, i + 3) = "N2"
        Next Item
        Dico.RemoveAll
        For Each C In Plage
            If Not Dico.exists(C.Value) Then
                Dico.Add C.Value, C.Value
            End If
        Next C
        For Each Item In Dico.items
            .[A60000].End(xlUp).Offset(1) = Item
        Next Item
        .Columns(1).AutoFit
        For Each C In Plage
            Col = Application.Match(Format(C.Offset(, 1), "dddd dd mmmm yyyy"), .[1:1], 0)
            Col = Col + Evaluate("Match(" & C.Offset(, 2).Address & ",{""_M"",""AM"",""N1"",""N2""},0)") - 1
            Ligne = Application.Match(C.Value, .[A:A], 0)
            .Cells(Ligne, Col) = C.Offset(, 3)
        Next C
    End With
End Sub

**docjo** · 15/08/2013, 19h36

Merci Daniel. J'apprends bien des choses avec ce code.
Un praticien peut avoir plus de 4 activités (te, uh, RT, CA, p, aa, ao , ai , a2 ,...) mais la journée est divisée en 4 parties (matin: "_M", aprés midi: "AM", Debut de nuit: "N1", Fin de nuit: "N2").
J'ai tout compris jusqu'à la partie essentielle:

Code :

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

1
2
3
4
5
6
7
 
        For Each C In Plage
            Col = Application.Match(Format(C.Offset(, 1), "dddd dd mmmm yyyy"), .[1:1], 0)
            Col = Col + Evaluate("Match(" & C.Offset(, 2).Address & ",{""_M"",""AM"",""N1"",""N2""},0)") - 1
            Ligne = Application.Match(C.Value, .[A:A], 0)
            .Cells(Ligne, Col) = C.Offset(, 3)
        Next C

Je comprends que dans la colonne A (Plage), pour chaque Praticien il va chercher la date correspondante mais [1:1] m'est inconnu de même que le zéro qui suit. Enfin, A quoi sert "Evaluate" ?
Le problème que j'identifie c'est qu'il modifie les dates de la feuille "Les colonnes". A quoi sert la boucle suivante ?

Code :

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

1
2
3
4
5
6
 
        For Each C In Plage.Offset(, 1)
            If Not Dico.exists(C.Value) Then
                Dico.Add C.Value, C.Value
            End If
        Next C

**Daniel.C** · 15/08/2013, 21h43

".[1:1]" est une écriture équivalente à ".Range("1:1")". "Match", c'est l'équivalent de la fonction EQUIV; le "0" y a la même signification (recherche de l'égalité)., Cette formule me retourne donc la première colonne de la date. Ensuite, j'ai utilisé "Evaluate" de la formule qu'il faut comprendre comme :

Code :

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

=EQUIV(Periode,{""_M"",""AM"",""N1"",""N2""},0),0)-1

qui donne le décalage par rapport à la colonne de la date :
0 : "_M"
1 : "AM"
etc.
Ce nombre ajouté à celui de la date détermine la colonne à impacter. J'ai utilisé "Evaluate" car, l'utilisation directe de "Match retournait une erreur sur l'utilisation des"{" et "}".

Code :

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

1
2
3
4
5
        For Each C In Plage.Offset(, 1)
            If Not Dico.exists(C.Value) Then
                Dico.Add C.Value, C.Value
            End If
        Next C

cette boucle sur les dates utilise un dictionnaire défini par :

Code :

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

Set Dico = CreateObject("Scripting.Dictionary")

pour éliminer les doublons de dates. J'en utilise une similaire pour éliminer les praticiens en double

**docjo** · 19/08/2013, 08h28

Ces explications sont claires. Encore une petite précision: à quoi sert de recopier la colonne I du dico en B1: cela fausse le tableau non ?

Code :

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

1
2
 
.[I:I].Copy .[B1]

En supprimant cette ligne, cela fonctionne mais les dates ne sont plus triées et il se produit un arrêt du code de façon aléatoire et à n'importe quel endroit.

**Daniel.C** · 19/08/2013, 11h05

Bonjour,

Tu as parfaitement raison ! Il faut remplir le dictionnaire avec la colonne I. Je t'envoie un code modifié.

Voici la macro; cependant, ou je n'ai pas tout compris, ou je trouve 12 périodes pour Abdelmoumen Y, par exemple, le 12/08/2013.

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 Tableau()
    Dim Plage As Range, C As Range, Dico As Object, Ligne As Long, Col As Integer
    With Sheets("les colonnes")
        Set Plage = .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
        .[I:I].ClearContents
        .[B:B].Copy .[I1]
        .[I:I].Sort .[I1], xlAscending, Header:=xlYes
        Set Dico = CreateObject("Scripting.Dictionary")
        i = -2
        For Each C In Plage.Offset(, 8)
            If Not Dico.exists(C.Value) Then
                Dico.Add C.Value, C.Value
            End If
        Next C
        .[I:I].ClearContents
    End With
    With Sheets("Résultat")
        .[A2] = "praticien"
        For Each Item In Dico.items
            i = i + 4
            .Cells(1, i).Resize(, 4).Merge
            .Cells(1, i) = Format(Item, "dddd dd mmmm yyyy")
            .Cells(2, i) = "_M"
            .Cells(2, i + 1) = "AM"
            .Cells(2, i + 2) = "N1"
            .Cells(2, i + 3) = "N2"
        Next Item
        Dico.RemoveAll
        For Each C In Plage
            If Not Dico.exists(C.Value) Then
                Dico.Add C.Value, C.Value
            End If
        Next C
        For Each Item In Dico.items
            .[A60000].End(xlUp).Offset(1) = Item
        Next Item
        .Columns(1).AutoFit
        For Each C In Plage
            Col = Application.Match(Format(C.Offset(, 1), "dddd dd mmmm yyyy"), .[1:1], 0)
            Col = Col + Evaluate("Match(" & C.Offset(, 2).Address & ",{""_M"",""AM"",""N1"",""N2""},0)") - 1
            Ligne = Application.Match(C.Value, .[A:A], 0)
            .Cells(Ligne, Col) = C.Offset(, 3)
        Next C
    End With
End Sub

**docjo** · 19/08/2013, 13h35

Pour moi, ce code est parfait. Je ne trouve que les 4 activités du 12/08.
Je te remercie vraiment pour ton aide, non seulement pour le code mais aussi pour m'avoir permis de comprendre plein de détails sur ce type de programmation. Vraiment super !

**Daniel.C** · 19/08/2013, 13h59

Voici la macro; cependant, ou je n'ai pas tout compris, ou je trouve 12 périodes pour Abdelmoumen Y, par exemple, le 12/08/2013.

J'aurais dû effacer cette ligne. Le problème de dates provenait de la première macro qui avait écrasé la colonne de dates.

Tableau croisé dynamique sans calcul [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager