problème de perf !

Version imprimable

problème de perf !

Bonjour à tous,

J'ai lu cette discussion et je rencontre la même problématique de choix multiples d'items dans le champ d'un TCD.
Citation:
Envoyé par Daniel.C
Pas testé :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Sub test2() ActiveSheet.PivotTables("PivotTable1").PivotSelect "Lieu[All]", xlLabelOnly, _ True With ActiveSheet.PivotTables("PivotTable1").PivotFields("Lieu") For i = 1 To .PivotItems.Count If .PivotItems(i).Name = "Interne Paris" Then .PivotItems(i).Visible = True Else .PivotItems(i).Visible = False End If Next i End With End Sub
La solution proposée fonctionne également pour moi. Par contre mon PivotField contient plus de 2500 valeurs et le balayage des valeurs une à une pour les passer en True ou False est excessivement long (plusieurs minutes) !
Connaissez vous un moyen d'optimiser ce code pour rendre son exécution plus rapide ?

Par avance merci !

06/06/2012, 17h26
Daniel.C

Bonjour,

Peux-tu mettre un classeur - sans données confidentielles - en PJ ? Indique les items que tu souhaites être visibles.
06/06/2012, 19h50
CoSmOzzz

1 pièce(s) jointe(s)

Bonjour,
Merci pour votre réponse rapide !

Voici un exemple de fichier anonymisé.
Avec le fichier original on est à plus de 2 minutes ... (les données ont des noms beaucoup plus longs...), ici environ 25s mais c'est toujours trop ..

1 pièce(s) jointe(s)

J'ai fait une autre approche en modifiant la source du tableau grâce à un filtre avancé :

Code:

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
Private Sub Bouton_Valider_Click()
 
    Application.ScreenUpdating = False
    Application.EnableEvents = False
 
    Dim Ctrl As Control
    Dim TableApplications() As String
    Dim i As Integer
    i = 0
 
    Dim PI As Object
 
    Dim oTCD As PivotTable
    Dim oTCD_Appli As PivotField
    Dim Ligne As Long
    Dim Plage As Range
    Dim Criteres As Range
    Set oTCD = Worksheets("TestAp").PivotTables("Tableau croisé dynamique1")
    Set oTCD_Appli = oTCD.PivotFields("AP")
 
    Dim DateStart
 
    'On stocke dans un dico les champs choisis dans la fenêtre (checkbox = true) :
    With Sheets("OrgaAp")
        .[G2:M65536].ClearContents
        Ligne = 1
        Set monDicoAppli = CreateObject("Scripting.Dictionary")
        For Each Ctrl In Me.Controls
            If TypeOf Ctrl Is MSForms.Checkbox Then
                If Ctrl.Value = True Then
                    monDicoAppli.Add Ctrl.Name, Ctrl.Name
                    Ligne = Ligne + 1
                    .Cells(Ligne, 13) = "=""=" & Ctrl.Name & """"
                End If
            End If
        Next Ctrl
        Unload Me
        Set Criteres = .Range(.[M1], .Cells(.Rows.Count, 13).End(xlUp))
        .Range(.[A1], .Cells(.Rows.Count, 5).End(xlUp)).AdvancedFilter xlFilterCopy, Criteres, .[G1:K1]
        Set Plage = .Range(.[G1], .Cells(.Rows.Count, 11).End(xlUp))
    End With
    With Sheets("TestAp")
        .PivotTables("Tableau croisé dynamique1").SourceData = "OrgaAp!" & Plage.Address(1, 1, xlR1C1)
    End With
    'pour calculer le temps d'éxcécution ...
    Application.EnableEvents = True
    Application.ScreenUpdating = True
 
    monDicoAppli.RemoveAll
 
 
End Sub

Regarde le classeur joint.

07/06/2012, 12h00
CoSmOzzz

Merci Daniel.
C'est effectivement une idée, je vais étudier ça plus en détail.

Autres précisions, la table OrgaAp est juste un référentiel,
et l'onglet TestAp permet de faire un filtre global sur les TCD d'une dizaine d'autres onglets. (Les vrais données sont dans une source de données externe sur laquelle pointe des TCD présents dans chacun des autres onglets.)

Le but est donc de choisir des champs dans l'onglet TestAp pour les appliquer à tous les autres onglets (qui contiennent les mêmes champs de recherches mais bcp plus de champ de données)

La méthode de modification de la source du tableau me parait ideale pour l'onglet TestAp, mais plus complexe dans les autres onglets (sources de données externe, pouvant dépasser les 65000 lignes...)

1 pièce(s) jointe(s)

Bonjour à tous,

J'ai un début de solution !

Le temps d'éxécution du fichier exemple est passé de 23s à 1s.
Et pour mon fichier original, de 2min30 à 43s ...

Pour cela il suffit en début de code :
-> d'empêcher le recalcul du TCD à chaque fois qu'on sélectionne un champs

Code:

MonTCD.ManualUpdate = True

-> d'empêcher le tri automatique des champs du TCD :

Code:

MonTCD.MonPivotField.AutoSort xlManual, MonTCD.MonPivotField.Name

-> au cas où, d'empêcher le recalul de la page excel :

Code:

Application.Calculation = xlCalculationManual

Et bien sûr on réactive tout, à la fin du code
Code:

1 2 3 4 5 MonTCD.MonPivotField.AutoSort xlAscending, MonTCD.MonPivotField.Name MonTCD.ManualUpdate = False Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True Application.ScreenUpdating = True
je joins le fichier Excel corrigé.

J'espère pouvoir faire diminuer encore ce temps dans mon fichier original ..

++

08/06/2012, 12h07
Daniel.C

Bravo. J'ai appris quelque chose dans la jungle de VBA TCD.