Lenteur exécution macro + formules
Bonjour,
Mon problème est le suivant:
Avec une macro j'ouvre FICHEIR1, copie tout son contenu pour le copier sur FICHIER2 (15 000 lignes).
A partir de là j'applique trois formules sur trois colonnes à la suite du tableau existant. Enfin sur les FEUILLES 2,3 et 4 j'ai des tableaux dynamique puis sur FEUILLE 5 des graphiques affiche la synthétisation effectuée.
Un bouton est relié à la MAJ des données, en cas d'un FICHIER 1 différent.
Cependant l'exécution est longue (+5min) et office ne répond pas pendant cette durée.
Malheureusement je ne peux joindre de fichier, photos sur demande.
Voici le code:
Sub Macro1()
'
' Macro1 Macro
'
'Le fichier exporté de SAP est ouvert
'puis son tableau est copié et coller dans la feuille "TableauSAP de notre fichier.
ChDir "N:\xxxxxxxxxxxxxxxxx"
Workbooks.Open Filename:="N:xxxxxxxxx.MHTML"
Cells.Select
Selection.Copy
Windows("export.MHTML").Activate
Worksheets("TableauSAP").Activate
Worksheets("TableauSAP").Range("A1").End(xlUp).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Workbooks("Export.MHTML").Close
' On applicque deux formules sur la colonne N = Double cloture et la colonne O = INTO et Q= Y2 retard ou non
Range("O2").Select
ActiveCell.FormulaR1C1 = "=IF(TableauSAP!C[-8]=""INTT ACEX"",IF(RC[-14]="""","""",IF(RC[-14]=R[-1]C[-14],IF(RC[-10]=R[-1]C[-10],0,IF(LEN(RC[-7])>=2,2,1)),0)),0)"
Range("P2").Select
ActiveCell.FormulaR1C1 = "=IF(TableauSAP!C[-9]=""INTO"",IF(RC[-14]="""","""",IF(RC[-14]=R[-1]C[-14],IF(RC[-10]=R[-1]C[-10],1,"" ""),0)),"" "")"
Range("Q2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-5]=""Y2"",IF(ISBLANK(RC[-12]),0,IF(TableauSAP!C[-11]=""INTT ACEX"",IF(RC[-17]="""","""",IF(RC[-17]=R[-1]C[-17],IF(RC[-13]=R[-1]C[-13],0,IF([@[Début de la panne]]-[@[Terminée le]]=0,1,IF([@[Début de la panne]]-[@[Terminée le]]<0,2,1))),IF(RC[-13]=R[-1]C[-13],0,IF([@[Début de la panne]]-[@[Terminée le]]=0,1,IF([@[Début de la panne]]-[@[Terminée le]]<0,2,1)))))" & _
",IF(TableauSAP!C[-11]=""INTT"",IF([@[Début de la panne]]-[@[Terminée le]]=0,1,IF([@[Début de la panne]]-[@[Terminée le]]<0,2,1)),0))),0)" & _
""
ActiveWorkbook.Worksheets("TableauSAP").ListObjects("Tableau1").Sort.SortFields _
.Clear
'filtrage par statut système / peu utile mais visuellement plus clair
ActiveWorkbook.Worksheets("TableauSAP").ListObjects("Tableau1").Sort.SortFields _
.Add Key:=Columns("G:G"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("TableauSAP").ListObjects("Tableau1").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("Global").Select
End SubMerci pour votre lecture, toute aide est la bienvenue !
Zouarv
Bonjour,
Commencer la procédure par :
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManualRemplacer :
Range("O2").Select
ActiveCell.FormulaR1C1 = "=IF(TableauSAP!C[-8]=""INTT ACEX"",IF(RC[-14]="""","""",IF(RC[-14]=R[-1]C[-14],IF(RC[-10]=R[-1]C[-10],0,IF(LEN(RC[-7])>=2,2,1)),0)),0)" Par :
Range("O2").FormulaR1C1 = "=IF(TableauSAP!C[-8]=""INTT ACEX"",IF(RC[-14]="""","""",IF(RC[-14]=R[-1]C[-14],IF(RC[-10]=R[-1]C[-10],0,IF(LEN(RC[-7])>=2,2,1)),0)),0)" Et idem pour les suivants
Terminer la procédure par :
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = TrueBonjour,
Merci pour votre réponse, j'ai modifié de la façon suivante:
Sub Macro1()
'
' Macro1 Macro
Dim start as single
Start=timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Le fichier exporté de SAP est ouvert
'puis son tableau est copié et coller dans la feuille "TableauSAP de notre fichier.
ChDir "N:\Service Technique\Maintenance\SAP\Bilan semestriel SAP\Année 2016"
Workbooks.Open Filename:="N:\Service Technique\Maintenance\SAP\Bilan semestriel SAP\export.MHTML"
Cells.Select
Selection.Copy
Windows("Bilan_2016.xlsm").Activate
Worksheets("TableauSAP").Activate
Worksheets("TableauSAP").Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Workbooks("Export.MHTML").Close
' On applicque deux formules sur la colonne N = Double cloture et la colonne O = INTO et Q= Y2 retard ou non
Range("O2").FormulaR1C1 = "=IF(TableauSAP!C[-8]=""INTT ACEX"",IF(RC[-14]="""","""",IF(RC[-14]=R[-1]C[-14],IF(RC[-10]=R[-1]C[-10],0,IF(LEN(RC[-7])>=2,2,1)),0)),0)"
Range("P2").FormulaR1C1 = "=IF(TableauSAP!C[-9]=""INTO"",IF(RC[-14]="""","""",IF(RC[-14]=R[-1]C[-14],IF(RC[-10]=R[-1]C[-10],1,"" ""),0)),"" "")"
Range("Q2").FormulaR1C1 = _
"=IF(RC[-4]=""Y2"",IF(ISBLANK(RC[-11]),0,IF(TableauSAP!C[-10]=""INTT ACEX"",IF(RC[-16]="""","""",IF(RC[-16]=R[-1]C[-16],IF(RC[-12]=R[-1]C[-12],0,IF([@[Début de la panne]]-[@[Terminée le]]=0,1,IF([@[Début de la panne]]-[@[Terminée le]]<0,2,1))),IF(RC[-12]=R[-1]C[-12],0,IF([@[Début de la panne]]-[@[Terminée le]]=0,1,IF([@[Début de la panne]]-[@[Terminée le]]<0,2,1)))))" & _
",IF(TableauSAP!C[-10]=""INTT"",IF([@[Début de la panne]]-[@[Terminée le]]=0,1,IF([@[Début de la panne]]-[@[Terminée le]]<0,2,1)),0))),0)" & _
""
ActiveWorkbook.Worksheets("TableauSAP").ListObjects("Tableau1").Sort.SortFields _
.Clear
'filtrage par statut système / peu utile mais visuellement plus clair
ActiveWorkbook.Worksheets("TableauSAP").ListObjects("Tableau1").Sort.SortFields _
.Add Key:=Columns("G:G"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("TableauSAP").ListObjects("Tableau1").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("Global").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Msgbox "durée du traitement: " & timer-start & " secondes"
End SubCependant office ne répond plus
Merci d'avance
Office ne répond plus
Au pire, le temps d'exécution devrait le même, mais pas plus long !
Mets des points d'arrêt ou exécutes la macro en pas à pas pour voir ou ça coince.