Optimisation code en vba pour création TCD

[Risbal14]

Bonjour à tous,

J'utilise le code ci-dessous dans une macro pour réaliser un tableau croisé dynamique.

Le délai de traitement est assez long du aux nombreuses redondances dans le code.

Savez-vous s'il est possible de simplifier le traitement des lignes et des colonnes avec le with afin d'optimiser le temps de traitement et d'éviter les redondances.

Merci de votre aide.

Boris.

' Tableau croisé dynamique sur données brutes
 
    ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    [Feuil1!A1].CurrentRegion.Address(, , xlR1C1, True), Version:=xlPivotTableVersion12).CreatePivotTable _
    TableDestination:="Feuil2!R1C1", _
    TableName:="Mon TCD", _
    DefaultVersion:=xlPivotTableVersion12

Sheets("Feuil2").Select
    
               
    'Mise en forme:
    
        ' Choix et format lignes :
        
             With ActiveSheet.PivotTables("Mon TCD").PivotFields("Facture id")
                .LayoutForm = xlTabular
                .Orientation = xlRowField
                .Position = 1
                .Caption = "N° de facture"
            End With
            
            With ActiveSheet.PivotTables("Mon TCD").PivotFields("Raison sociale")
                .LayoutForm = xlTabular
                .Orientation = xlRowField
                .Position = 2
                .Caption = "Société facturée"
            End With
            
            With ActiveSheet.PivotTables("Mon TCD").PivotFields("Centre Payeur")
                .LayoutForm = xlTabular
                .Orientation = xlRowField
                .Position = 3
                .Caption = "N° de sous-compte"
            End With
            
            With ActiveSheet.PivotTables("Mon TCD").PivotFields("N° utilisateur")
                .LayoutForm = xlTabular
                .Orientation = xlRowField
                .Position = 4
                .Caption = "Numéro de l'utilisateur"
            End With
        
            With ActiveSheet.PivotTables("Mon TCD").PivotFields("Nom utilisateur")
                .LayoutForm = xlTabular
                .Orientation = xlRowField
                .Position = 5
                .Caption = "Nom et prénom de l'utilisateur"
            End With
            
            With ActiveSheet.PivotTables("Mon TCD").PivotFields("Référence utilisateur")
                .LayoutForm = xlTabular
                .Orientation = xlRowField
                .Position = 6
                .Caption = "Numéro de référence de l'utilisateur"
            End With
            
            With ActiveSheet.PivotTables("Mon TCD").PivotFields("N° de téléphone")
                .LayoutForm = xlTabular
                .Orientation = xlRowField
                .Position = 7
                .Caption = "Numéro de téléphone"
            End With
            
            With ActiveSheet.PivotTables("Mon TCD").PivotFields("Zone appelée")
                .LayoutForm = xlTabular
                .Orientation = xlRowField
                .Position = 8
                .Caption = "Libellé opérateur"
            End With
            
            With ActiveSheet.PivotTables("Mon TCD").PivotFields("Nom de la rubrique de niveau 1")
                .LayoutForm = xlTabular
                .Orientation = xlRowField
                .Position = 9
            End With
            
            With ActiveSheet.PivotTables("Mon TCD").PivotFields("Nom de la rubrique de niveau 2")
                .LayoutForm = xlTabular
                .Orientation = xlRowField
                .Position = 10
            End With
            
            With ActiveSheet.PivotTables("Mon TCD").PivotFields("Période")
                .LayoutForm = xlTabular
                .Orientation = xlRowField
                .Position = 11
            End With
            
            With ActiveSheet.PivotTables("Mon TCD").PivotFields("Segment")
                .LayoutForm = xlTabular
                .Orientation = xlRowField
                .Position = 12
            End With
            
            With ActiveSheet.PivotTables("Mon TCD").PivotFields("Rubrique")
                .LayoutForm = xlTabular
                .Orientation = xlRowField
                .Position = 13
            End With
            
            With ActiveSheet.PivotTables("Mon TCD").PivotFields("PU réel en € HT")
                .LayoutForm = xlTabular
                .Orientation = xlRowField
                .Position = 14
            End With
            
            With ActiveSheet.PivotTables("Mon TCD").PivotFields("Unité d'oeuvre")
                .LayoutForm = xlTabular
                .Orientation = xlRowField
                .Position = 15
            End With
            
            With ActiveSheet.PivotTables("Mon TCD").PivotFields("Zone Pays")
                .LayoutForm = xlTabular
                .Orientation = xlRowField
                .Position = 16
            End With
            
            With ActiveSheet.PivotTables("Mon TCD").PivotFields("Racine N° appelé")
                .LayoutForm = xlTabular
                .Orientation = xlRowField
                .Position = 17
            End With
            
        ' Choix et format colonnes :
            
            With ActiveSheet.PivotTables("Mon TCD").PivotFields("Coût HT")
                .Orientation = xlDataField
                .Caption = "Montant brut"
                .NumberFormat = "0.00 €"
            End With
            
            With ActiveSheet.PivotTables("Mon TCD").PivotFields("Volume réel")
                .Orientation = xlDataField
                .Function = xlSum
                .NumberFormat = "0.00"
                
            End With
            
            With ActiveSheet.PivotTables("Mon TCD").PivotFields("Volume facturée")
                .Orientation = xlDataField
                .Function = xlSum
                .NumberFormat = "0.00"
                
            End With
    
    'Suppression des sous-totaux :
        Dim p As PivotField
        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

 

[patoq]

Re : Optimisation code en vba pour création TCD

Bonjour Risbal14,

Déja ajoute Application.ScreenUpdating = False en début de procédure et Application.ScreenUpdating = True à la fin de la procédure .

Cdt

 

[Risbal14]

Re : Optimisation code en vba pour création TCD

Salut Patoq,

J'ai inséré Application.ScreenUpdating au début et à la fin dans ma macro qui comporte plusieurs séquences.

Y'a t-il un intérêt à mettre la formule Application.ScreenUpdating plusieurs fois?

Boris.