XL 2019 Temps éxécution très long sur un userform

Did25

XLDnaute Occasionnel
Bonjour le forum XLD , après vous avoir sollicité pour la construction de mon fichier de gestion de calcul retraite , je constate une éxécution très longue de mon userfom lorsque je fait une requête ,existe t-il une solution pour améliorer cela ,ou faut-il changer la façon de procéder ,merci de votre aide
 

Pièces jointes

  • Fichier de calcul retraite multi-postes.xlsm
    576.1 KB · Affichages: 17
Solution
Bonsoir Yeahou ,j'ai fait le test et j'ai effectué une modification sur le module n°2 avec :
f1.Range("D3").FormulaR1C1 = MoisRecuperation5x8f1.Range("D3").FormulaR1C1 = MoisRecuperation5x8
afin de mettre le nombre de mois sur le tableau de bord ,c'est nickel ,il me reste a l'adapter sur les autres rythmes de travail ,j'aurai peut-être des choses à voir au sujet des trois quart temps mais ce n'est pas certain ,merci encore bonne soirée

eriiic

XLDnaute Barbatruc
Bonjour,

Ce qui est long est cette partie.
Ajoute les 2 lignes Application.Calculation, ça sera 2.7 fois plus rapide.
VB:
    'Report sur le calendrier
    Application.Calculation = xlCalculationManual
    For i = 12 To DerCol_f1 Step 3
        Range(f1.Cells(4, i), f1.Cells(34, i)).FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-2],Trame5x8!R1C1:R" & DerLig_f2 & "C3,3,0),"""")"
        Range(f1.Cells(4, i), f1.Cells(34, i)).Value = Range(f1.Cells(4, i), f1.Cells(34, i)).Value
    Next i
    Application.Calculation = xlCalculationAutomatic
Mais comme sur mon test la date n'est pas changée entre avant et après cet ajout, je ne sais pas si ton calcul reste correct dans tous les cas.
A tester
eric
 

eriiic

XLDnaute Barbatruc
Comme ça te prend 90% du temps, si tu peux laisser les formules ça devrait aller mieux.
Pas d'intérêt à les supprimer pour les remettre, en 2 écritures en plus vu que tu remplaces par la formule par la valeur dans la foulée.
Ecrire est très chronophage
 

Did25

XLDnaute Occasionnel
Ok je comprends c'est très juste mais je ne sais pas comment faire autrement car en fonction du profil ,je n'aurais pas le même nombre de jours et le calcul de départ sera différent ,et donc la trame sera différente ,a moins d'écrire directement sur le calendrier sans passer par la trame ,mais là c'est une autre histoire
 
Dernière édition:

Did25

XLDnaute Occasionnel
Salut Yeahou ,et oui tu dis juste ,grâce a toi et XLD ,j'ai bien avancé ,mon fichier non anonymisé et beaucoup plus conséquent avec 5 calendriers et donc 5 rythmes de travail ,des calculs spécifiques pour obtenir des résultats précis mais mon problème c'est le temps d'exécution de l'userform calcul retraite qui est plutôt long malgré l'intervention d'eriiic ,peut-être revoir la conception mais je dois garder cette mise en forme et ces calendriers ,merci de ton intérêt
 

Yeahou

XLDnaute Accro
Supporter XLD
Re,

D'accord, je peux regarder, mais pour être sûr de ne pas passer à coté d'un problème qui deviendra gênant ultérieurement, quelques questions :
- tes rythmes de travail sont toujours tous sur 10 jours ? ils n'ont jamais de variation ? ou supposes tu, dans ta projection, qu'un agent restera toujours sur le même rythme jusqu'à son départ. Peut être prévois tu de faire plusieurs BDD ?
- si tu calcules un départ dans 10 ans (je vois un calendrier jusqu'en 2041), tu fais manuellement des estimations sur les jours de récup et les jours épargnés à venir ?
C'est juste pour m'imprégner de ta façon de concevoir la projection.

Bien cordialement, @+
 
Dernière édition:

Did25

XLDnaute Occasionnel
Pour le 5x8 sur 10 jours ,le 2x8 sur 14 jours ,et le 1x8 sur 7 jours ,dans le calcul ,on part du principe que l'agent restera dans ce rythme de travail mais en ce qui concerne le 7x8 le calcul est de 196 jours avec un risque de permutation en 5x8 avant la fin de son activité mais c'est geré dans le calendrier .Pour ce qui est des projections je part sur des acquis d'épargne temps pouvant aller jusqu'à 5 ans en fonctions de la date de départ officielle Carsat et je décompte en fonction des postes du calendrier ,je précise aussi que cette durée de 20 année me permet de faire des estimations en fonction de certains accords d'entreprises
 
Dernière édition:

Yeahou

XLDnaute Accro
Supporter XLD
si j'ai bien compris, tu auras donc quatre fichiers différents, un pour chaque rythme ?
et à l'intérieur de chaque rythme, une variation de départ de cycle spécifique à adapter pour chaque agent en fonction de la date de début de calendrier.
j'aurai peut être besoin d'un cas concret pour tester !
je te tiens au courant.

Bien cordialement
 

Did25

XLDnaute Occasionnel
Non j'ai un fichier avec 4 feuilles de calcul 7x8,5x8,2x8,1x8 et un base de donnée pour les formules de postes et 4 feuilles de trame associées aux feuilles de calcul mais suffit de faire un travail de modification sur le 5x8 et je m'occuperai du reste ,je pense pouvoir m'en sortir, attention la base de calcul doit partir de la date carsat et non le départ calendrier
 

Yeahou

XLDnaute Accro
Supporter XLD
voila ta sub modifiée, c'est quasi instantané chez moi, dis moi si cela te convient, sinon je peux modifier pour ne mettre à jour que ce qui est nécessaire pour que ce soit plus rapide mais est ce utile ?
VB:
Sub Recherche_Depart5x8_dans_Trame5x8()
    Application.ScreenUpdating = False
    Set f1 = Sheets("Calcul 5x8")
    Set f2 = Sheets("Trame5x8")
    DerCol_f1 = f1.Range("XFD3").End(xlToLeft).Column + 2
    DerLig_f2 = f2.Range("A" & Rows.Count).End(xlUp).Row
    f2.Range("C1:C" & DerLig_f2).ClearContents
    d = Application.WorksheetFunction.Match(Date_Depart5x8, f2.Range("A1:A" & DerLig_f2), 0)
    On Error GoTo Gere_Erreurs
    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    'Placement des "congés" 7
    If Conges5x8 > 0 Then
        Do While f2.Cells(d, "B") = 0
            d = d - 1
        Loop
        For i = Conges5x8 To 1 Step -1
            If f2.Cells(d, "B") <> 0 Then
                f2.Cells(d, "C") = 7
            Else
                i = i + 1
            End If
            d = d - 1
        Next
    End If
   
    'Placement des "Divers congés" 6,9,5,8
    If DiversConges5x8 > 0 Then
        Do While f2.Cells(d, "B") = 0
            d = d - 1
        Loop
        For i = DiversConges5x8 To 1 Step -1
            If f2.Cells(d, "B") <> 0 Then
                f2.Cells(d, "C") = 6
            Else
                i = i + 1
            End If
            d = d - 1
        Next
    End If
   
    'Placement des "JoursRecuperation" 9,5,8
    If JoursRecuperation5x8 > 0 Then
        Do While f2.Cells(d, "B") = 0
            d = d - 1
        Loop
        For i = JoursRecuperation5x8 To 1 Step -1
            If f2.Cells(d, "B") <> 0 Then
                f2.Cells(d, "C") = 9
            Else
                i = i + 1
            End If
            d = d - 1
        Next
    End If
   
    'Placement des "JoursEpargnes" 5,8
    If JoursEpargnes5x8 > 0 Then
        Do While f2.Cells(d, "B") = 0
            d = d - 1
        Loop
        For i = JoursEpargnes5x8 To 1 Step -1
            If f2.Cells(d, "B") <> 0 Then
                f2.Cells(d, "C") = 5
            Else
                i = i + 1
            End If
            d = d - 1
        Next
    End If
   
    'Placement des "TroisQuartTemps" 8
    If TroisQuartTemps5x8 > 0 Then
        Do While f2.Cells(d, "B") = 0
            d = d - 1
        Loop
        For i = TroisQuartTemps5x8 To 1 Step -1
            If f2.Cells(d, "B") <> 0 Then
                f2.Cells(d, "C") = 8
            Else
                i = i + 1
            End If
            d = d - 1
        Next
    End If
   
    'Report sur le calendrier
    For i = 12 To DerCol_f1 Step 3
        Range(f1.Cells(4, i), f1.Cells(34, i)).FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-2],Trame5x8!R1C1:R" & DerLig_f2 & "C3,3,0),"""")"
        Range(f1.Cells(4, i), f1.Cells(34, i)).Value = Range(f1.Cells(4, i), f1.Cells(34, i)).Value
    Next i
    Set f1 = Nothing
    Set f2 = Nothing
    MsgBox "Projection terminée", vbOKOnly + vbInformation
Gere_Erreurs:
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
End Sub
 

Did25

XLDnaute Occasionnel
Comme d'habitude c'est une merveille ,je l'ai essayé sur toutes les feuilles des quatre cycles ,nickel hyper rapide et sans erreur ,tout simplement parfait merci beaucoup ,je vais poursuivre mon travail ,merci à tous aussi et principalement XLD
 

Discussions similaires

Statistiques des forums

Discussions
286 624
Messages
1 877 554
Membres
160 771
dernier inscrit
Tekuni
Haut Bas