Filtre automatique et Mise en Forme conditionnel dans VBA

Question

J'ai tant bien que mal réussi a faire la macro que je souhaitais (tri des données brutes, suppression des "Pas" si autre imputation, crée deux tableaux dynamiques a partir de ces données triés) mais il me reste deux problèmes tres facile à résoudre pour des "pros"... Le 1er est un probleme avec le filtre automatique (voir le bug dans le fichier joint). J'aimerais tout simplement trié mes données de l'onglet "DonneesBrutes" par ordre décroissant... Le 2eme est à la fin de la macro (je n'ai rien écrit dessus encore), j'aimerais mettre une mise en forme automatique UNIQUEMENT sur les données allant du R01 au R04 (surligné les 10% valeurs plus importantes, sur les 2 TCT). Mon probleme réside dans la définition de la zone car la zone ne sera jamais de même taille (il peut avoir plusieurs imputation différentes, pas tous les pas concernées,...). Il faut donc arriver à définir la zone de résultats dans les TCT pour les imputations R01 à R04. Si ce n'est pas clair, n'hésitez pas à me demander! Merci beaucoup de votre aide...

Jean-Eric · Answer

J'ai 3 points à voir avec toi pour comprendre ce que tu souhaites Problème 1 : Trier les données par ordre décroissant ----&gt; Quel est le critère à retenir pour le tri (ou encore le champ ou la colonne)? Problème 2 : ----&gt; A quoi correspondent les termes R01 et R04? Question : ----&gt; Que signifie TCT Cordialement...

Jean-Eric · Answer

Re,

Au sujet des 10% valeurs plus importantes,

1) Les 10 valeurs les plus importantes ou les valeurs supérieures de 10% au total du TCD?

2) Est-ce sur le total du TCD ou par champ (R01, R02, etc...)

Ci-dessous, code du 1er. TCD à insérer dans un module.

Qu'en penses-tu?

Cordialemet

Public Sub Créer_TCD_1()

Dim Plage As Range
Dim PTCache As PivotCache
Dim PT As PivotTable
Dim p As PivotField

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    On Error Resume Next
        Worksheets("Arrêt").Delete
    On Error Resume Next

    Set Plage = Range("A1").CurrentRegion

    Set PTCache = ActiveWorkbook.PivotCaches.Add( _
        SourceType:=xlDatabase, SourceData:=Plage)

    Worksheets.Add after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = "Arrêt"

    Set PT = PTCache.CreatePivotTable(tabledestination:=Range("A1"), tablename:="TCD1")

    With PT

        .PivotFields("Imputation").Orientation = xlColumnField
        .PivotFields("Pas").Orientation = xlRowField
        .PivotFields("Côté").Orientation = xlRowField
        .PivotFields("Durée").Orientation = xlDataField
            With .PivotFields("Nombre de durée")
                .Caption = "Somme des durées "
                .Function = xlSum
                .NumberFormat = "hh:mm:ss"
            End With

        With .PivotFields("Imputation")
            .PivotItems("MAI").Visible = False
            .PivotItems("Eq C").Visible = False
            .PivotItems("LOG").Visible = False
        End With
            With .PivotFields
                For Each p In ActiveSheet.PivotTables(1).PivotFields
                    If p.Orientation = 1 Then p.Subtotals = Array(False, False, False, False, _
                        False, False, False, False, False, False, False, False)
                Next p
            End With

        .RowGrand = False

    End With

Jean-Eric · Answer

Re,

Ci-joint fichier TCD 1 avec format personnalisée pour les valeurs supérieures à 10% du total par champ (RO1, R02, etc...)

Lancer :

1 - TCD_1

2 -EssaiCouleur

J'attends tes remarques

Cordialement

49macro-suivi-prod-v2.xlsm (78.83 Ko)