Bonjour,
J'essaye d'automatiser une tâche redondante par le biais d'une macro plutôt simple. Un tableau croisé dynamique est créé à partir d'un fichier de 600 000 lignes. Des filtres sont ensuite appliqués puis les données filtrées sont copiées sur une autre feuille.
Sur cette nouvelle feuille qui ne contient alors plus que 74000 lignes, je m'aperçois que le traitement est anormalement long et qu'une fois celui-ci terminé, je ne peux plus rien faire dans le tableau par manque de ressources(j'essayais de supprimer les colonnes A et B de la feuille LRU colonne). J'ai tenté de vider le presse papier mais rien n'y fait.
Auriez-vous une idée ? Ma macro est-elle si lente que ça ou est ce que je génère des choses qui font ralentir la machine ? Que sais je
Le traitement me semble plutôt basique. Je pense que mes nombreux copiés/collés sont à l'origine de mon problème. De quelle manière alors pourrais je régler ça ? S'il est nécessaire de joindre un fichier, dites le moi.
Merci beaucoup !
J'essaye d'automatiser une tâche redondante par le biais d'une macro plutôt simple. Un tableau croisé dynamique est créé à partir d'un fichier de 600 000 lignes. Des filtres sont ensuite appliqués puis les données filtrées sont copiées sur une autre feuille.
Sur cette nouvelle feuille qui ne contient alors plus que 74000 lignes, je m'aperçois que le traitement est anormalement long et qu'une fois celui-ci terminé, je ne peux plus rien faire dans le tableau par manque de ressources(j'essayais de supprimer les colonnes A et B de la feuille LRU colonne). J'ai tenté de vider le presse papier mais rien n'y fait.
Auriez-vous une idée ? Ma macro est-elle si lente que ça ou est ce que je génère des choses qui font ralentir la machine ? Que sais je
Code:
Option Explicit
Sub CreatePivot()
Application.ScreenUpdating = False
Application.CutCopyMode = False
Dim objTable As PivotTable, objField As PivotField
Dim maPlage As Range
Dim DernLigne As Long
DernLigne = Range("A" & Rows.Count).End(xlUp).Row
Set maPlage = Range("A1:Q" & DernLigne)
ActiveWorkbook.Sheets("Feuil1").Select
Range("A1").Select
Sheets.Add.Move After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "TCD"
Worksheets("TCD").PivotTableWizard _
SourceType:=xlDatabase, _
SourceData:=Worksheets("Feuil1").Range("A:Q").Address(, , xlR1C1, True), _
TableDestination:=Worksheets("TCD").Range("A1"), _
tableName:="TCD_1"
Set objTable = Worksheets("TCD").PivotTables("TCD_1")
Set objField = objTable.PivotFields("Article")
objField.Orientation = xlRowField
Set objField = objTable.PivotFields("Composant")
objField.Orientation = xlRowField
Set objField = objTable.PivotFields("Nb Dmd rep")
objField.Orientation = xlDataField
Set objField = objTable.PivotFields("Composant")
Call miseEnColonne
End Sub
Sub miseEnColonne()
Application.ScreenUpdating = False
' == AJOUT D'UNE FEUILLE ET COPIE DES DONNES ==
Sheets.Add.Move After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "LRU colonne"
Sheets("TCD").Columns("A:B").Copy
Sheets("LRU colonne").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("A:B").EntireColumn.AutoFit
'==============================================
'==== NOUVEAU FILTRE ET SUPPRESSION DE LIGNES==
Rows("1:1").Delete
Range("A:B").AutoFilter Field:=1, _
Criteria1:="=*Total*", _
Operator:=xlAnd
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A:B").AutoFilter Field:=1, _
Criteria1:="(vide)", _
Operator:=xlAnd
Range("A2:B2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
ActiveSheet.Range("A1").AutoFilter Field:=1
'==============================================
'SUPPRESSION DU TCD (PENSANT QU'IL ETAIT A L ORIGINE DU PB
Application.DisplayAlerts = False
Sheets("TCD").Delete
Application.DisplayAlerts = True
'== DEBUT DU TRAITEMENT PERMETTANT DE METTRE LES LIGNES EN COLONNES
'Bien que sans doute peu optimisée, j'ai déjà testé cette macro seule, et elle
'n'est pas si lente qu'utilisée dans ce cadre.
Dim celluleRef As Range
Set celluleRef = Range("A1")
Dim nbLignes As Long
nbLignes = Range("A" & Rows.Count).End(xlUp).Row
Dim LRU As Range
Set LRU = Range("C1")
Dim decalageCellule As Long
decalageCellule = 0
Dim cellComposants As Range
Dim tableauComposants()
Dim indice As Double
indice = 2
While (indice < nbLignes)
If celluleRef.Cells(indice) <> "" Then
Dim iComposants As Integer
Dim i As Integer, nbLig As Integer
celluleRef.Cells(indice).Copy
iComposants = 1
Set cellComposants = celluleRef.Cells(indice, 2)
cellComposants.Select
nbLig = Range(Selection, Selection.End(xlDown)).Rows.Count
ReDim tableauComposants(nbLig)
For i = 1 To nbLig
If Not (cellComposants.Cells(i) = "FLU") Then
tableauComposants(iComposants) = cellComposants.Cells(i)
iComposants = iComposants + 1
End If
Next i
LRU.Offset(0, decalageCellule).Select
ActiveSheet.Paste
For iComposants = 1 To UBound(tableauComposants)
LRU.Offset(iComposants, decalageCellule).Value = tableauComposants(iComposants)
Next iComposants
decalageCellule = decalageCellule + 1
End If
indice = indice + 1
Wend
Application.CutCopyMode = True
End SubLe traitement me semble plutôt basique. Je pense que mes nombreux copiés/collés sont à l'origine de mon problème. De quelle manière alors pourrais je régler ça ? S'il est nécessaire de joindre un fichier, dites le moi.
Merci beaucoup !
Dernière édition:
