VBA et tableau croisé dynamique

K

kenavo

XLDnaute Junior
Bonjour,

J' ai un problème de performance de mon code
J' ai un fichier CSV que j' intègre dans un fichier, ensuite il genére un tableau crois' dynamique.
Le programme marche mais il est lent, en faisant pas à pas j' ai constaté que les lenteurs venaient de la partie où il supprime les Totaux des lignes

Mon problème, je n' arrive pas en enlever ses lignes lors de la création du tableau croisé..
J' ai réalisé mon code avec l'enregistreur de macro
Voici le code :
Code: 
Sub CSV()
'
' CSV Macro
' Macro enregistrée le 02/05/2010 par FA
'

'Selection de l onglet extration_fg
Sheets("extraction_fg").Select
    Cells.Select
'Supprime les données de la feuille
    Selection.ClearContents
    Range("A1").Select
    
    'Ouverture fichier CSV
    Workbooks.Open Filename:= _
        "C:\extraction\extraction_fg.csv"
    Columns("A:A").Select
    
    Selection.Copy
    Windows("Classeur2.xls").Activate
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    'Conversion données CSV
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array( _
        33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1)) _
        , TrailingMinusNumbers:=True
    
   
    ' tableau croisé
    Range("A1").Select
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        "extraction_fg!R1C1:R31584C38").CreatePivotTable TableDestination:="", _
        TableName:="Tableau croisé dynamique1", DefaultVersion:= _
        xlPivotTableVersion10
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select
    With ActiveSheet.PivotTables("Tableau croisé dynamique1")
        .ColumnGrand = False
        .RowGrand = False
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Nom Ag." _
        )
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Code Ag.")
        .Orientation = xlRowField
        .Position = 2
    End With
    ActiveWindow.SmallScroll Down:=3
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Fournisseur Nom")
        .Orientation = xlRowField
        .Position = 3
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Fournisseur Code")
        .Orientation = xlRowField
        .Position = 4
    End With
    ActiveWindow.SmallScroll Down:=-9
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Statut")
        .Orientation = xlRowField
        .Position = 5
    End With
    ActiveWindow.SmallScroll Down:=-6
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Date Commande")
        .Orientation = xlRowField
        .Position = 6
    End With
    ActiveWindow.SmallScroll Down:=3
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Ref Commande")
        .Orientation = xlRowField
        .Position = 7
    End With
    ActiveWindow.SmallScroll Down:=3
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Personne")
        .Orientation = xlRowField
        .Position = 8
    End With
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveSheet.PivotTables("Tableau croisé dynamique1").AddDataField ActiveSheet. _
        PivotTables("Tableau croisé dynamique1").PivotFields("Montant Commande"), _
        "Somme de Montant Commande", xlSum
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1

'[COLOR="Red"]Cette partie rend le traitement long[/COLOR]
    Range("C10").Select
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Fournisseur Nom").Subtotals = Array(False, False, False, False, False, False, False, _
        False, False, False, False, False)
    Range("D9").Select
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Fournisseur Code").Subtotals = Array(False, False, False, False, False, False, False _
        , False, False, False, False, False)
    Range("E8").Select
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Statut"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
        False, False)
    Range("F10").Select
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Date Commande").Subtotals = Array(False, False, False, False, False, False, False, _
        False, False, False, False, False)
    Range("G8").Select
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Ref Commande" _
        ).Subtotals = Array(False, False, False, False, False, False, False, False, False, False _
        , False, False)
    Range("B7").Select
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Code Ag."). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
        False, False)
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Nom Region")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Code Sté")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Nom Sté" _
        )
        .Orientation = xlPageField
        .Position = 1
    End With
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    
    'Referme le fichier CSV
    Windows("extraction_fg.csv").Activate
    ActiveWindow.Close
End Sub


Merci de votre aide
 
Dernière édition:
Trier par date Trier par votes
K

kenavo

XLDnaute Junior
Re : VBA et tableau croisé dynamique

Re bonjour,

En effet ce sera plus parlant avec un exemple

Dans le tableau croisé je ne souhaite pas avoir :
Total Montaigu


Mon fichier d' origine à 35 000 lignes

Merci
 

Pièces jointes

  • extraction_fg.zip
    22.7 KB · Affichages: 39
Vote positif 0 Vote négatif
JCGL

JCGL

XLDnaute Barbatruc
Re : VBA et tableau croisé dynamique

Bonjour à tous,

Peux-tu essayer avec ce code sur tes 35 000 lignes :

Code: 
Option Explicit
Sub CSV()
    Application.ScreenUpdating = 0
    Sheets("extraction_fg").Select
    Cells.ClearContents
    Range("A1").Select
    'Ouvrture fichier CSV
    Workbooks.Open Filename:="C:\extraction\extraction_fg.csv"
"
    Columns("A:A").Copy
    Windows("Classeur2.xls").Activate
    ActiveSheet.Paste
    Application.CutCopyMode = False
    'Conversion données CSV
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
                            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True
 
    ' tableau croisé
    ActiveWorkbook.Names.Add Name:="Base_TCD", RefersToR1C1:= _
                             "=OFFSET(extraction_fg!R1:R65536,,,COUNTA(extraction_fg!C1),COUNTA(extraction_fg!R1))"
    Range("A1").Select
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
                                   "extraction_fg!Base_TCD").CreatePivotTable TableDestination:="", _
                                   TableName:="TCD1", DefaultVersion:=xlPivotTableVersion10
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select
    With ActiveSheet.PivotTables("TCD1")
        .ColumnGrand = False
        .RowGrand = False
        With .PivotFields("Nom Ag.")
            .Orientation = xlRowField
            .Position = 1
        End With
        With .PivotFields("Code Ag.")
            .Orientation = xlRowField
            .Position = 2
        End With
        With .PivotFields("Fournisseur Nom")
            .Orientation = xlRowField
            .Position = 3
        End With
        With .PivotFields("Fournisseur Code")
            .Orientation = xlRowField
            .Position = 4
        End With
        With .PivotFields("Statut")
            .Orientation = xlRowField
            .Position = 5
        End With
        With .PivotFields("Date Commande")
            .Orientation = xlRowField
            .Position = 6
        End With
        With .PivotFields("Ref Commande")
            .Orientation = xlRowField
            .Position = 7
        End With
        With .PivotFields("Personne")
            .Orientation = xlRowField
            .Position = 8
        End With
        .AddDataField ActiveSheet.PivotTables("TCD1").PivotFields("Montant Commande"), "Somme de Montant Commande", xlSum
        .PivotFields("Fournisseur Nom").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        .PivotFields("Fournisseur Code").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        .PivotFields("Statut").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        .PivotFields("Date Commande").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        .PivotFields("Ref Commande").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        .PivotFields("Code Ag.").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        With .PivotFields("Nom Region")
            .Orientation = xlPageField
            .Position = 1
        End With
        With .PivotFields("Code Sté")
            .Orientation = xlPageField
            .Position = 1
        End With
        With .PivotFields("Nom Sté")
            .Orientation = xlPageField
            .Position = 1
        End With
    End With
    ActiveWorkbook.ShowPivotTableFieldList = False
    Application.CommandBars("PivotTable").Visible = False
    'Referme le fichier CSV
    Windows("extraction_fg.csv").Activate
    ActiveWindow.Close
    Application.ScreenUpdating = 1
End Sub

A+ à tous
 
Vote positif 0 Vote négatif

Discussions similaires

A
  • Résolu(e)
XL 2016 Regroupement dates sur TCD
Réponses
3
Affichages
329
Aldonanou
A
3
  • Question
XL 2010 Copier un tableau croisé dynamique même si celui ci a un nombre de ligne variable
Réponses
4
Affichages
300
306255
3
M
  • Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
109
marie3107
M
C
  • Résolu(e)
XL 2016 Remplir automatiquement un tableau d'après des conditions et des valeurs
Réponses
11
Affichages
1 K
ERIC S
ERIC S
M
  • Question
Microsoft 365 Copier / coller avec mise en forme VBA
Réponses
0
Affichages
155
marie3107
M
L
  • Question
XL 2016 Macro et suppressions de lignes
Réponses
9
Affichages
609
fanfan38
fanfan38
O
  • Question
XL 2021 VBA / Macro et tableau croisé dynamique
Réponses
3
Affichages
223
oguruma
oguruma
B
  • Résolu(e)
XL 2016 Modifier ou créer une macro imprimer une sélection de zones
Réponses
5
Affichages
492
berru76
B
D
  • Question
XL 2016 Création Tableau Croisé Dynamique VBA
Réponses
2
Affichages
426
dysorthographie
dysorthographie
U
  • Question
Autres Enregistrer sur Onglet TOTO
Réponses
2
Affichages
386
un internaute
U

Membres actuellement en ligne

3 membres et 54 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 229
Messages
2 086 425
Membres
103 206
dernier inscrit
diambote