Améliorer une Macro TCD

Version imprimable

Bonjour les amis ,

Je suis très novice coté vba et j'aimerais avoir votre aide svp afin d'améliorer une macro qui me permet de manipuler le filtre des TCD ,par contre je me retrouve avec plein de TCD je ne sais pas si c'est possible d'utiliser qu'un seul pour le meme rendu

Merci d'avance

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
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
If Intersect(Target, Range("A2:A13")) Is Nothing Then Exit Sub
 
 
Dim pt1, pt2, pt3, pt4, pt5, pt6, pt7, pt8, pt9, pt10 As PivotTable
 
Dim pt As PivotTable
 
Dim FieldISIN1, FieldISIN2, FieldISIN3, FieldISIN4, FieldISIN5, FieldISIN6, FieldISIN7, FieldISIN8, FieldISIN9, FieldISIN10 As PivotField
 
Dim NewRegionISIN1, NewRegionISIN2, NewRegionISIN3, NewRegionISIN4, NewRegionISIN5, NewRegionISIN6, NewRegionISIN7, NewRegionISIN8, NewRegionISIN9, NewRegionISIN10 As String
 
 
Set pt1 = Worksheets("Sheet4").PivotTables("PivotTable1")
Set pt2 = Worksheets("Sheet4").PivotTables("PivotTable2")
Set pt3 = Worksheets("Sheet4").PivotTables("PivotTable3")
Set pt4 = Worksheets("Sheet4").PivotTables("PivotTable4")
Set pt5 = Worksheets("Sheet4").PivotTables("PivotTable5")
Set pt6 = Worksheets("Sheet4").PivotTables("PivotTable6")
Set pt7 = Worksheets("Sheet4").PivotTables("PivotTable7")
Set pt8 = Worksheets("Sheet4").PivotTables("PivotTable8")
Set pt9 = Worksheets("Sheet4").PivotTables("PivotTable9")
Set pt10 = Worksheets("Sheet4").PivotTables("PivotTable10")
Set FieldRegion1 = pt1.PivotFields("ISIN1")
Set FieldRegion2 = pt2.PivotFields("ISIN2")
Set FieldRegion3 = pt3.PivotFields("ISIN3")
Set FieldRegion4 = pt4.PivotFields("ISIN4")
Set FieldRegion5 = pt5.PivotFields("ISIN5")
Set FieldRegion6 = pt6.PivotFields("ISIN6")
Set FieldRegion7 = pt7.PivotFields("ISIN7")
Set FieldRegion8 = pt8.PivotFields("ISIN8")
Set FieldRegion9 = pt9.PivotFields("ISIN9")
Set FieldRegion10 = pt10.PivotFields("ISIN10")
 
NewRegionISIN1 = Worksheets("Sheet4").Range("A2").Value
NewRegionISIN2 = Worksheets("Sheet4").Range("A3").Value
NewRegionISIN3 = Worksheets("Sheet4").Range("A4").Value
NewRegionISIN4 = Worksheets("Sheet4").Range("A5").Value
NewRegionISIN5 = Worksheets("Sheet4").Range("A6").Value
NewRegionISIN6 = Worksheets("Sheet4").Range("A7").Value
NewRegionISIN7 = Worksheets("Sheet4").Range("A8").Value
NewRegionISIN8 = Worksheets("Sheet4").Range("A9").Value
NewRegionISIN9 = Worksheets("Sheet4").Range("A10").Value
NewRegionISIN10 = Worksheets("Sheet4").Range("A11").Value
 
With pt1
FieldRegion1.ClearAllFilters
FieldRegion1.CurrentPage = NewRegionISIN1
pt1.RefreshTable
End With
With pt2
FieldRegion2.ClearAllFilters
FieldRegion2.CurrentPage = NewRegionISIN2
pt2.RefreshTable
End With
With pt3
FieldRegion3.ClearAllFilters
FieldRegion3.CurrentPage = NewRegionISIN3
pt3.RefreshTable
End With
With pt4
FieldRegion4.ClearAllFilters
FieldRegion4.CurrentPage = NewRegionISIN4
pt4.RefreshTable
End With
With pt5
FieldRegion5.ClearAllFilters
FieldRegion5.CurrentPage = NewRegionISIN5
pt5.RefreshTable
End With
With pt6
FieldRegion6.ClearAllFilters
FieldRegion6.CurrentPage = NewRegionISIN6
pt6.RefreshTable
End With
With pt7
FieldRegion7.ClearAllFilters
FieldRegion7.CurrentPage = NewRegionISIN7
pt7.RefreshTable
End With
With pt7
FieldRegion7.ClearAllFilters
FieldRegion7.CurrentPage = NewRegionISIN7
pt7.RefreshTable
End With
With pt8
FieldRegion8.ClearAllFilters
FieldRegion8.CurrentPage = NewRegionISIN8
pt8.RefreshTable
End With
With pt9
FieldRegion9.ClearAllFilters
FieldRegion9.CurrentPage = NewRegionISIN9
pt9.RefreshTable
End With
With pt10
FieldRegion10.ClearAllFilters
FieldRegion10.CurrentPage = NewRegionISIN10
pt10.RefreshTable
End With
End Sub

18/08/2015, 19h35
parmi

Bonjour,

Pour un début...
Quand tu déclares des variables comme ceci, seule la dernière est typée de ce que tu écris, ici PivotTable

Code:

Dim pt1, pt2, pt3, pt4, pt5, pt6, pt7, pt8, pt9, pt10 As PivotTable

Les autres sont Variant

C'est la même chose dans les différentes déclarations que tu as mises
Il te faudrait écrire le type pour chacune des variables

Si tu essaies comme ceci, qu'est-ce que ça donne ?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, Range("A2:A13")) Is Nothing Then Exit Sub
 
    Dim I As Integer
    Dim Pvt As PivotTable
    Dim PFld As PivotField
    Dim Region As String
 
    For I = 1 To 10
        Set Pvt = Worksheets("Sheet4").PivotTables("PivotTable" & I)
        Set PFld = Pvt.PivotFields("ISIN" & I)
        Region = Worksheets("Sheet4").Range("A" & I + 1).Value
 
        PFld.ClearAllFilters
        PFld.CurrentPage = Region
        Pvt.RefreshTable
    Next
 
End Sub

19/08/2015, 13h52
boubou114

Merci Parmi pour le retour
Je t'es envoyé en inbox le fichier que je veux optimisé , ça l'air de marché juste un petit beug au niveau du refresh

Merci encore
19/08/2015, 14h09
parmi

Je n'ai pas reçu le fichier, mais je ne pense pas que tu puisses le joindre dans le Inbox...
Quel est le problème exactement ? Message d'erreur ?
Si oui, lequel ?
19/08/2015, 14h47
boubou114

On effet je peux l'envoyer :/
Apparement y'a un soucis avec la ligne : PFld.CurrentPage = Region que et aussi à chaque fois que je séléctionne une des 10 cellule y'a tous qui se met en refrech automatiquement

Merci encore
19/08/2015, 15h00
parmi

probablement parce que tu as mis ça dans

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Ce ne serait pas plutôt ça que tu voulais utiliser ?

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
19/08/2015, 15h09
boubou114

ça marche parfaitement

Merci beaucoupppppp :mrgreen:

j'ai juste une dernière question est ce possible d'utiliser qu'un seul TCD au lieu de 10 car c'est les memes en fait
19/08/2015, 15h25
parmi
Pas certain de comprendre (?)
Tu veux raffraîchier tous les TCD d'un coup comme ça ?
Code:

1 2 3 Private Sub Worksheet_Change(ByVal Target As Range) ActiveWorkbook.RefreshAll End Sub
Si la plage de données peut changer de grandeur, peut-être que tu pourrais utiliser un Tableau au lieu d'une plage standard.
Les TCD vont toujours s'adapter à la grandeur de ce tableau... Il ne reste qu'à raffraîchir d'un coup comme mentionné ci-haut.
21/08/2015, 12h55
boubou114

Hello Parmi

En effet c'est une bonne solution ce que tu me propose ,que je ne peux malheureusement pas mettre en pratique :/ je dois ajouter quoi comme ligne stp ?

Tu proposes que je mettes à tableau dynamique si j'ai compris non ?

Merci encore
21/08/2015, 13h29
parmi

Oui, un tableau au sens 2007 et plus.
Menu Insérer > Tableau

Hello,

C'est encore moi :mouarf:
Alors voilà j'ai modfié un peu ton code Parmi ou j'ai ajouter la variable num pour prendre en consideration que les cases saisie comme suit , la macroo s'excute puis il m'affiche error 1004 au niveau de la ligne : PFld.CurrentPage = Region , any help please ?

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
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim nnum As Integer
    nnmu = Sheets("Sheet4").Cells(2, 11).Value
 
 
    If Intersect(Target, Range("A2:A11")) Is Nothing Then Exit Sub
 
    Dim I As Integer
    Dim Pvt As PivotTable
    Dim PFld As PivotField
    Dim Region As String
 
    nmun = 10
 
    For I = 1 To nnmu
        Set Pvt = Worksheets("Sheet4").PivotTables("PivotTable" & I)
        Set PFld = Pvt.PivotFields("ISIN" & I)
        Region = Worksheets("Sheet4").Range("A" & I + 1).Value
        PFld.ClearAllFilters
        PFld.CurrentPage = Region
        Pvt.RefreshTable
    Next
 
End Sub

25/08/2015, 20h06
parmi

Qu'est-ce que contient Region ?
Est-ce vraiment nécessaire ?
26/08/2015, 11h08
boubou114

ça contient les cellules extérieures dont lesquelles je saisie les ISIN qui vont filtrer les TCD