Analyse macro trop lente

Le 12/12/2017 à 02:17

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.

15perso.zip (70.19 Ko)
Le 12/12/2017 à 08:33

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
Le 12/12/2017 à 08:45

Bonjour subirubi.

Bonjour Office.

Impossible d'ouvrir le fichier chez moi.

Le 12/12/2017 à 08:56

Bonjour à tous

thebenoit59 a écrit :

Impossible d'ouvrir le fichier chez moi.

Pareil.

Bye !

Le 12/12/2017 à 08:58

Idem...

Le 12/12/2017 à 09:01

Bonjour,

Il est en mode masqué : YAKA faire Affichage > Afficher...

A+

Le 12/12/2017 à 11:03

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+

Le 12/12/2017 à 17:00

Bonjour Tout le monde,

Je vous remercie pour votre réponse.

J'ai remplacé une partie du code soumis, mais lors du lancement de l'application j'ai un message d'erreur qui s'affiche.

erreur code

Y-a-t-il une suggestion pour corriger ça ?

Le 12/12/2017 à 17:48

Allo Forum,

Je voulais juste joindre un fichier qui s'ouvre.

Merci à vous.

2macro-d-analyse.xlsm (76.25 Ko)
Le 12/12/2017 à 21:31

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+

Le 12/12/2017 à 21:48

Bonjour Galopin,

Voici le fichier qui va avec la macro. Je m'excuse pour l'oubli.

Merci pour ton aide. Vraiment.

3liste-admissiblite-so-17-vaca.zip (35.81 Ko)
Le 12/12/2017 à 23:18

Je n'ai pas d'erreur : La macro se déroule correctement jusqu'à :

impscr

A+

Le 13/12/2017 à 02:10

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)

msg erreur ligne d erreur

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()
msg erreur analyseblancvaca
Le 13/12/2017 à 05:24

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+

Rechercher des sujets similaires à "analyse macro trop lente"