Discussion :

[BebertBCN]

Bonjour,

J'ai trouvé cette macro qui permet de filtrer un TCD en fonction d'une valeur dans une cellule.

J'aimerais pouvoir dupliquer ce code pour pouvoir avoir 6 cellules qui déterminent la valeur 6 filtres différents du même TCD (chaque cellule choisit la valeur dans un filtre avec un nom unique)

La valeur de Cellule C4 determine le filtre Accounting Responsible

La valeur C7 détermine le filtre Sales

ETC...

Ce ne doit pas être cumulatif mais un traitement indépendant de chaque filtre.

Je suis bloqué et j'ai vraiment besoin de votre aide

Voici mon code :

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
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xStr As String
    On Error Resume Next
    If Intersect(Target, Range("C4")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Share your comments here").PivotTables("PivotTable1")
    Set xPFile = xPTable.PivotFields("Accounting Responsible")
    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
 
End Sub

Merci beaucoup !!

[78chris]

Bonjour

Pourquoi ne pas utiliser tout simplement des segments ?

Tu dit "non cumulatif" : c'est à dire qu'il faut désactiver tous les filtres avant d'appliquer le dernier choisi.

ClearAllFilters doit s'appliquer au TCD pas au champ dans ce cas

[BebertBCN]

Yes exactement : Tu dit "non cumulatif" : c'est à dire qu'il faut désactiver tous les filtres avant d'appliquer le dernier choisi

Que veux tu dire par. Segment? Sorry mais je débute en vba... peux tu stp me. Montrer le. Schéma en code ?
Merci bcp pour ton aide !!

[78chris]

RE

Les segments (slicers) ce n'est pas du vba mais une façon de filtrer d'un clic un TCD et/ou GCD voir plusieurs s'il sont la même source.

mais ils sont par défaut cumulatifs.

Pour le VBA je t'ai donné la réponse "ClearAllFilters doit s'appliquer au TCD pas au champ"

donc remplace xPFile.ClearAllFilters par xPTable.ClearAllFilters

[BebertBCN]

Re

Ok pour le xPFile.ClearAllFilters par xPTable.ClearAllFilters

En revanche, la solution avec les slicers ne convient pas malheureusement parce que cumulatifs...

et c'est justement ce que je n'ai pas réussi a faire en VBA, parce que lorsque je rajoute les différentes cellules et nom de filtres cela cumule :

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
Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
On Error Resume Next
If Intersect(Target, Range("C4,...,...")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Share your comments here").PivotTables("PivotTable1")
Set xPFile = xPTable.PivotFields("Accounting Responsible")
Set xPTable = Worksheets("Share your comments here").PivotTables("PivotTable1")
Set xPFile = xPTable.PivotFields("Sales")
.....
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
 
End Sub

Merci !

[BebertBCN]

Hello,

Voici le code que j'ai tenté mais cela ne fonctionne pas... Quelqu'un peut il m'aider ?

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
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xStr As String
    On Error Resume Next
    If Intersect(Target, Range("C4")) Is Nothing Then
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Share your comments here").PivotTables("PivotTable1")
    Set xPFile = xPTable.PivotFields("Accounting Responsible")
    xStr = Target.Text
    xPTable.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
 
    ElseIf Intersect(Target, Range("C7")) Is Nothing Then
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Share your comments here").PivotTables("PivotTable1")
    Set xPFile = xPTable.PivotFields("Vendor")
    xStr = Target.Text
    xPTable.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
 
    ElseIf Intersect(Target, Range("C10")) Is Nothing Then
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Share your comments here").PivotTables("PivotTable1")
    Set xPFile = xPTable.PivotFields("Line Manager")
    xStr = Target.Text
    xPTable.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
 
    ElseIf Intersect(Target, Range("C13")) Is Nothing Then
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Share your comments here").PivotTables("PivotTable1")
    Set xPFile = xPTable.PivotFields("Sales Director")
    xStr = Target.Text
    xPTable.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
 
    ElseIf Intersect(Target, Range("C16")) Is Nothing Then
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Share your comments here").PivotTables("PivotTable1")
    Set xPFile = xPTable.PivotFields("CFO")
    xStr = Target.Text
    xPTable.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
 
    ElseIf Intersect(Target, Range("C19")) Is Nothing Then
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Share your comments here").PivotTables("PivotTable1")
    Set xPFile = xPTable.PivotFields("CEO")
    xStr = Target.Text
    xPTable.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
 
    End If
 
 
End Sub