Discussion :

[a.ouguerzam]

bonjour,

je vous communique une petite problematique, j'ai un tableau croise dynamique et sur le tableau j'ai besoin de mettre une mise en forme avec couleurs avec des conditions sauf que le croisé dynamique bouge selon les donnes par exemple j'ai commence par mettre le code VBA pour coulorie Q1 en rouge.
ci dessous un code que j'ai deja essaye d'optimisé à partir d'une macro mais j'arrive pas je suis desole je suis un debutant VBA

ci dessous mon code

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub CouleurQ()
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotSelect "Q1", _
   Range("A4:C7").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub

je vous laisse le fichier ci joint en cas de besoin Quartile.xlsm

Cdt,
ouga

[a.ouguerzam]

j'ai rajouter le code ci dessous ;

Code :

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

Range("A:A").Find("Q1").Select

mais il me chercher juste ou il se trouve Q1 la cellule Q1 seulement.

[a.ouguerzam]

il me reste juste comme lui dire de suivre la recherche pour qu'elle cherche les Q1 qui suit

ci dessous une capture d'ecran :

[a.ouguerzam]

personne !!!

je vous communique le code je partage avec vous ci dessous le scripte :

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
 
Option Explicit
Public Sub CouleurQ()
Dim ws As Worksheet, pt As PivotTable, rngData As Range
 
    With Application
        .PivotTableSelection = True: .ScreenUpdating = False
    End With
 
    Set ws = ActiveSheet: Set pt = ws.PivotTables(1)
    Set rngData = _
            Intersect(pt.PivotFields("Quartile").PivotItems("Q1").DataRange.EntireRow, _
            pt.PivotFields("Agent").DataRange)
    Set rngData = _
            Union(rngData, pt.PivotFields("Quartile").PivotItems("Q1").LabelRange, _
            pt.PivotFields("Quartile").PivotItems("Q1").DataRange)
    rngData.Interior.Color = vbRed
 
    Set rngData = Nothing: Set pt = Nothing: Set ws = Nothing
 
End Sub

cdt,
OUGA