Analyse macro trop lente
Bonjour Forum,
Il y a quelque temps de ça une macro a été faite pour analyser des étapes de nomination selon un texte régisseur. La macro s'appelle "Analyse_adm_bla"
Cependant, au lancement de l'analyse la macro tourne comme une usine à gaz, ça ralentit considérablement Excel.
Je me tourne vers les fins connaisseurs afin de m'expliquer ce que je pourrais enlever ou remplacer dans le code afin de le rendre plus souple., va-t-on dire.
Par exemple:
Ce code je peux le réduire
Range("G8").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Pour devenir ainsi:
Range("G8").Select
With Selection
.WrapText = True
End With
Mais est-ce que cela aide vraiment ?
Je vous remercie pour vos précieux conseils.
Cdlt.
Bonjour,
Essaie de désactiver les mises à jour d’écran lors de l’exécution en ajoutant "Application.screenUpdating = False" en debut de code puis "Application.screenUpdating = True " à la fin . Exemple :
Sub XxXxX()
Application.screenUpdating = False
'TON CODE .....
Application.screenUpdating = True
End sub
Bonjour subirubi.
Bonjour Office.
Impossible d'ouvrir le fichier chez moi.
Bonjour,
Il est en mode masqué : YAKA faire Affichage > Afficher...
A+
Pour le Application.screenUpdating = False il y en a un au début dans la macro de lancement ça suffira...
Je donne ici un ébauche de début de rationalisation.
Bien sur rien n'est vérifié ni testé c'est très théorique... Il faudrait pouvoir déboguer sur pièce !
Cependant ça donne déjà une bonne approche du problème.
Je ne me suis pas attardé sur les mises en forme ni sur les formules : C'est une histoire de fou !
Bien sur on peut faire... Mais pas avec une boule de cristal :
On commencera par supprimer tous les Select, Selection, ActiveCell, FormulaR1C1... puis toutes les propriétés par défaut inutiles...
On pourrait reprendre une bonne partie de ce travail dans la macro AnalyseBlancsTEMP
Prévoir une bonne dose de Doliprane...
Sub AnalyseAdmissBlancs_SOURIRE()
'Touche de raccourci du clavier: Ctrl+Maj+H
'Cette macro vérifie le format du fichier source provenant de InfoRH et retourne un message d'erreur si le format est incompatible.
'Si le fichier est conforme, lance la Macro finale
'Définition des variables
Dim ComptFeuil As Long
Dim ComptCol1 As Long
Dim ComptCol2 As Long
Dim ComptCol3 As Long
Dim ComptCol4 As Long
Application.ScreenUpdating = False
'Renomme les onglets pour la suite de la macro - à adapter selon les modifications apportées par SMO
Sheets("STATUTS ET INFO. D'EMPLOI").Name = "Sheet1"
Sheets("RÉSULTATS ÉTAPES DU PROTOCOLE").Name = "Sheet2"
Sheets("MÊME EMPLOI-24 DERNIERS MOIS").Name = "Sheet3"
Sheets("ÉLIGIBILITÉS ACTIVES").Name = "Sheet4"
Sheets("RÉPONSES DU QUESTIONNAIRE").Name = "Questionnaire"
Sheets("NIVEAU D'ÉTUDES").Name = "Scolarité"
Sheets("ENTREVUE GÉNÉRIQUE PRO").Name = "PRO"
ComptFeuil = ActiveWorkbook.Sheets.Count
If ComptFeuil = 7 Then
ComptCol1 = Sheets("Sheet1").UsedRange.Columns.Count
ComptCol2 = Sheets("Sheet2").UsedRange.Columns.Count
ComptCol3 = Sheets("Sheet3").UsedRange.Columns.Count
ComptCol4 = Sheets("Sheet4").UsedRange.Columns.Count
If ComptCol1 = 17 And ComptCol2 = 6 And ComptCol3 = 8 And ComptCol4 = 9 Then
Call Macrofinale
Else
MsgBox ("Le format du fichier source provenant d'InfoRH n'est pas compatible avec l'utilisation de cette macro. ")
End If
Else: MsgBox ("Le format du fichier source provenant d'InfoRH n'est pas compatible avec l'utilisation de cette macro. ")
End If
Application.ScreenUpdating = True
End Sub
Sub Macrofinale()
'Cette macro vérifie le type d'affichage devant être traité et lance le traitement approprié.
'Définition des variables
Dim Rep As Integer
Rep = MsgBox("Avez-vous pensé à sauvegarder votre fichier?", vbYesNo + vbQuestion, "mDF XLpages.com")
If Rep = vbNo Then
Application.Dialogs.Item(xlDialogSaveAs).Show
End If
'Enlève le R, DEP et STA
With Sheets("Sheet1").Range("A3")
.Replace What:="VPERM-R", Replacement:="VPERM", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="EAU-DEP", Replacement:="EAU", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="EAU-STA", Replacement:="EAU", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End With
With Sheets("Sheet1").Range("A4")
.UnMerge
.FormulaR1C1 = _
"=MID(Sheet1!R[-1]C,40+LEN(MID(Sheet1!R[-1]C,40,FIND(""-"",Sheet1!R[-1]C)-40))+4,(IF(ISERROR(FIND(""VPERM"",Sheet1!R[-1]C)),4,5)))"
End With
If Sheets("Sheet4").Range("A4") = "VACA" Then
Call AnalyseBlancsVACA
ElseIf Sheets("Sheet4").Range("A4") = "VPERM" Then
Call AnalyseBlancsVACA
ElseIf Sheets("Sheet4").Range("A4") = "TEMP" Then
Call AnalyseBlancsTEMP
ElseIf Sheets("Sheet4").Range("A4") = "QUAL" Then
Call AnalyseBlancsQUAL
ElseIf Sheets("Sheet4").Range("A4") = "BPRE" Then
Call AnalyseBlancsQUAL
Else: MsgBox ("Cette fonctionnalité peut être utilisée pour les affichages de type VACA, VPERM, TEMP et QUAL seulement. Votre affichage ne répond pas à ces critères.")
End If
End Sub
Sub AnalyseBlancsVACA()
'Cette macro analyse les candidatures d'un affichage selon l'application de l'article 19.09
'de la convention collective des fonctionnaires municipaux pour les affichages VACA et VPERM
Dim WB As Workbook
Dim ComptElig As Long
Dim comptCandidats As Long
Dim Arr(1 To 63)
Set WB = ActiveWorkbook
Arr = ("Acronyme AC CDNNDG MHM PMR RDPPAT RPP SO VM VSMPE A BSG LAC LAS MN OUTR PIRO SLA SLE V AJEF " & _
"CH CONTR QV DG EAU FIN MEVT SAI SCARM SITE SLAM SPVM SSIM TI CFP CSE DC LARONDE OMBU ORGEXTE " & _
"SM VER BTM BIG GREF DEV SPO EVAL GPI DSS GPVMR ENV CONCA CULT COMM IVT EPV MRA RH APP AJU SIM")
Sheets.Add After:=Sheets(5)
ActiveSheet.Name = "Table"
With Sheets("Table")
For i = 1 To 63
.Cells(i, 1) = Split(Arr)(i - 1)
Next
' Si ajout, attention , allonger la place de ACCRO, faire les ajouts VACA et TEMP
Arr = ("Numéro 56 59 55 54 51 57 53 52 58 79 76 88 89 87 75 82 86 85 83 41 36 43 35 02 49 04 34 44 45 " & _
"28 11 37 10 42 17 12 60 31 26 80 38 06 20 46 03 05 09 16 18 19 21 23 24 25 27 28 29 33 36 39 41 10")
For i = 1 To 63
.Cells(i, 2) = Split(Arr)(i - 1)
Next
WB.Names.Add Name:="ACCRO", RefersTo:="=Table!A1:B43"
'Création de la table de l'annexe L-3
.Range("C22") = "DE"
.Range("D22") = "Vers"
.Range("E22") = "Concatener"
Arr = ("763810 731830 743810 743810 762410 762410 792820 792820 792820 784810 792430 707410 ") & _
("749810 793440 791860 700760 700750 792840 744420 707810 782900 782930 782930 ")
For i = 23 To 45
.Cells(i, 3) = Split(Arr)(i - 23)
Next
Arr = ("731810 731810 754810 762410 743810 754810 784810 792430 749810 749810 792820 792820 ") & _
("784810 793410 707430 700750 700760 744420 792840 782910 782930 782900 771830")
For i = 23 To 45
.Cells(i, 4) = Split(Arr)(i - 23)
Next
.Range("E23").FormulaR1C1 = "=CONCATENATE(RC[-2],RC[-1])"
.Range("E23").AutoFill Destination:=.Range("E23:E45"), Type:=xlFillDefault
.Columns("E:E").EntireColumn.AutoFit
End With
'Création de la feuille Analyse
Sheets("Sheet1").Copy Before:=Sheets(1)
ActiveSheet.Name = "Analyse"
'Suppression des lignes d'entête 1 à 8 provenant de InfoRH
With Sheets("Analyse")
.Rows("1:8").Delete Shift:=xlUp
.Range("A65536").End(xlUp).Delete Shift:=xlUp
.Range("A65536").End(xlUp).Delete Shift:=xlUp
.Columns("O:P").Delete Shift:=xlToLeft
.Columns("P:P").Select
.Range(Selection, Selection.End(xlToRight)).Delete Shift:=xlToLeft
End With
'Columns("O:Q").Select
'Selection.Delete Shift:=xlToLeft
'Ajoute / nomme des colonnes pour l'analyse des candidatures et mise en forme
Sheets("Sheet1").Name = "Base"
Sheets("Sheet2").Name = "Étape Réussie"
Sheets("Sheet3").Name = "Admissibilité"
Sheets("Sheet4").Name = "Éligibilité"
'************************************* Suite non traitée
A+
Allo Forum,
Je voulais juste joindre un fichier qui s'ouvre.
Merci à vous.
Je peux me tromper mais... Ce message d'erreur ne me parait pas significatif !
Il signifie simplement que VBA est déjà occupé par une erreur au moment ou tu essaies de relancer l'exécution de la macro.
Donc tu as juste à arrêter la macro en cours et à la relancer...
J'ai déjà dit que je ne veux pas m'amuser à construire un fichier valide pour tester une macro...
Un fichier vide ne me sert à rien.
Si tu ne veux pas fournir le fichier correspondant avec la macro débrouille toi...
A+
Bonjour Galopin,
Voici le fichier qui va avec la macro. Je m'excuse pour l'oubli.
Merci pour ton aide. Vraiment.
Bonsoir Galopin,
En fait, l'erreur affichée sur ta capture d'écran ne devrait pas s'afficher car le code d'affichage inclut le terme VACA (voir cellule A3)
L'erreur devrait survenir chez toi au moment où la macro essaiera d'accéder à un autre tableau (voir les captures d'écran)
Après j'ai collé une portion de l'ancien code
With Selection
Selection.UnMerge
Range("A4").Select
ActiveCell.FormulaR1C1 = _
"=MID(Sheet1!R[-1]C,40+LEN(MID(Sheet1!R[-1]C,40,FIND(""-"",Sheet1!R[-1]C)-40))+4,(IF(ISERROR(FIND(""VPERM"",Sheet1!R[-1]C)),4,5)))"
End With
If Range("A4") = "VACA" Then
Call AnalyseBlancsVACA
ElseIf Range("A4") = "VPERM" Then
Call AnalyseBlancsVACA
ElseIf Range("A4") = "TEMP" Then
Call AnalyseBlancsTEMP
ElseIf Range("A4") = "QUAL" Then
Call AnalyseBlancsQUAL
ElseIf Range("A4") = "BPRE" Then
Call AnalyseBlancsQUAL
Else: MsgBox ("Cette fonctionnalité peut être utilisée que pour les affichages de type VACA, VPERM, TEMP et QUAL seulement. Votre affichage ne répond pas à ces critères.")
End If
Mais ensuite elle bute là-dessus:
(cette ligne devient surlignée en jaune)
Sub AnalyseBlancsVACA()
Bonjour,
Modifie comme suit :
Sub AnalyseBlancsVACA()
Dim WB As Workbook
Dim ComptElig As Long
Dim comptCandidats As Long
Dim Arr 'au lieu de Dim Arr (1 to 63)
'le reste sans changement
Dans la première macro, mettre :
Application.DisplayAlerts = False
With Sheets("Sheet1").Range("A4")
.UnMerge
.FormulaR1C1 = 'la suite sans changement...
A+