[RESOLU] Macros Partage et ralentissement : quels sont les bons usages ?

[Crisky]

Bonjour à tous,

Mon constat est simple : j'ai une macro qui traite environ 3000 lignes de données (avec boucles conditions....)
Quand le fichier est exclusif le traitement se fait en 1,35 mns, quand le fichier est partagé et que je suis seul dessus le traitement met plus de 2mns.

Dans la macro j'utilise divers astuces déjà donné sur le site : screenupdating=false, calculation=xlmanual

Mais de toute facon le comportement est le même que le fichier soit partagé ou non.

Donc je fais appel à vos lumières pour connaitre les bonnes pratiques concernant des macros qui tournerait sur des fichiers partagés

Je me suis mis déjà quelques règles :
declaration de toutes mes variables
mes objets sont au maximum défini avant les appels

Avez vous d'autres idées pour optimiser le code ?

Merci d'avance à tous

 

[Staple1600]

Re : Macros Partage et ralentissement : quels sont les bons usages ?

Bonsoir à tous

Avez vous d'autres idées pour optimiser le code ?

Oui.

Pouvoir déjà commencer à lire le code afin de tenter de l'optimiser ...🙄

Donc copies ton code VBA dans ta discussion ou joins un fichier Excel exemple contenant ce code.
(en ayant pris le temps au préalable de supprimer les données confidentielles si besoin)

 

[Crisky]

Re : Macros Partage et ralentissement : quels sont les bons usages ?

Bonjour,

Voila le code, désolé j'aurais pu le mettre dès le début
Certaines Variables sont des constantes déclarées dans un module séparé

Ca fait un beau pavé de code, si vous voulez des explications n'heistez pas

Pour résumé, j'affiche des données avec la recurrence par jour (ces données sont sur 2 feuilles différentes dans le classeur) et sur la restitution je fais des mises en forme en fonction des données d'une autre feuille

Pl.plan etant les feuilles de données
ws etant la feuille de restit
trncode etant une zone d'une autre feuille qui contient les données auxquelles on va comparer les restits

Option Explicit

Sub ActualisationActiviteQuotidenne()

Call DES
Call TypeTrn

Range("A7:AI65536").Clear

Dim TrnCode As Object
Dim cel As Object
Dim PlanTp As Object
Dim lg As Integer
Dim NomPlanning As String
Dim j As Integer, k As Integer, l As Integer 'pour boucle
Dim Vartemp As Integer
Dim ws As Object

Set ws = ActiveWorkbook.ActiveSheet

'determination de la zone de recherche des codes tournées
Set TrnCode = Worksheets(F_Trn).Range(Z_TrnColCode)
lg = PLActQuot

For Each cel In TrnCode
    'si le code est le meme que la ligne precedente je passe à la ligne suivante
    If cel.Value = cel.Offset(-1, 0).Value Or cel.Value = 0 Then GoTo suivant
    If cel.Offset(0, 1) = TypeTrnRegul Then GoTo suivant 'supprimer cette ligne si on veut les regul d'heures
    Vartemp = 0
   
    'mise en place des données des colonnes A->D
    ws.Cells(lg, 2) = cel.Offset(0, 1) 'type trn
    ws.Cells(lg, 3) = cel.Offset(0, -1) 'lib trn
    ws.Cells(lg, 4).FormulaLocal = "=SOMME(E" & lg & ":AI" & lg & ")"
    
    'calcul par jour des données à reporter
    For k = PCPlan To DCPlan Step 2
        'Remonte la tournée prévue dans les planning
        For j = 1 To 2
            If j = 1 Then NomPlanning = "Planning " & Worksheets(F_Besoins).Range(Z_Grp1) Else NomPlanning = "Planning " & Worksheets(F_Besoins).Range(Z_Grp2)
                Set PlanTp = Worksheets(NomPlanning)
                For l = PLPlan To 3400 Step 6
                    If IsEmpty(PlanTp.Cells(l, 1)) = True Then Exit For
                    If UCase(PlanTp.Cells(l + 1, k)) = UCase(cel.Value) Then Vartemp = Vartemp + 1
                Next l
        Next j
        ws.Cells(lg, k / 2 + 1) = Vartemp
        
        'calcul de la couleur si le nb de tournée prevue est different du reel
        If Weekday(ws.Cells(6, k / 2 + 1), 2) > 5 Then ws.Cells(lg, k / 2 + 1).Interior.ColorIndex = 37
        If ws.Cells(lg, k / 2 + 1) <> cel.Offset(0, (Weekday(ws.Cells(PLActQuot - 1, k / 2 + 1), 2)) * 2 + 3) And ws.Cells(lg, 2) <> TypeTrnAbsNonRem And ws.Cells(lg, 2) <> TypeTrnAbsRem Then
            If ws.Cells(lg, k / 2 + 1) = 0 Then ws.Cells(lg, k / 2 + 1).Interior.ColorIndex = 3
            If ws.Cells(lg, k / 2 + 1) > cel.Offset(0, (Weekday(ws.Cells(PLActQuot - 1, k / 2 + 1), 2)) * 2 + 3) Then ws.Cells(lg, k / 2 + 1).Interior.ColorIndex = 46
            If ws.Cells(lg, k / 2 + 1) < cel.Offset(0, (Weekday(ws.Cells(PLActQuot - 1, k / 2 + 1), 2)) * 2 + 3) And ws.Cells(lg, k / 2 + 1) <> 0 Then ws.Cells(lg, k / 2 + 1).Interior.ColorIndex = 44
        End If
        Vartemp = 0
        'grise la cellule si jour ferie
        If Application.WorksheetFunction.CountIf(Worksheets(F_Parametres).Range("A:A"), ws.Cells(PLActQuot - 1, k / 2 + 1)) > 0 Then ws.Cells(lg, k / 2 + 1).Interior.Color = RGB(204, 204, 204)
    Next k
lg = lg + 1
suivant:
Next cel

'mef tab
    Range("B6").Select
    Selection.CurrentRegion.Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
    End With

Call ACT

End Sub

Sub DES()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
End Sub

Sub ACT()
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub

Sub TypeTrn()
TypeTrnAbsRem = Worksheets(F_Parametres).Cells(2, 4)
TypeTrnAbsNonRem = Worksheets(F_Parametres).Cells(3, 4)
TypeTrnRegul = Worksheets(F_Parametres).Cells(4, 4)
TypeTrnExploit = Worksheets(F_Parametres).Cells(5, 4)

End Sub

 

[Crisky]

Re : Macros Partage et ralentissement : quels sont les bons usages ?

J'oubliais de préciser :
Ce n'est pas la macro qui etais concerné à l'ouverture du post mais les ecarts sont encore plus flagrant.
10 s en exclusif
3,23 mns en partagé
94 boucles traitées

 

[Crisky]

Re : Macros Partage et ralentissement : quels sont les bons usages ?

Une idée me viens, si je copie le contenu des données dans des variables tableaux et que le resultat du traitement est aussi mis dans un autre tableau.
A la fin de la macro je copie le tableau sur la feuille, ca devrait fonctionner ?
Logiquement ca devrait etre rapide, d'apres les diverses lectures que j'ai faite.

Qu'en pensez vous ?

 

[Staple1600]

Re : Macros Partage et ralentissement : quels sont les bons usages ?

Bonsoir à tous

Crisky
Ces lignes de codes font la même chose que les tiennes

Sub maContribution()
'mef tab
    With Range("B6").CurrentRegion
        .HorizontalAlignment = -4108: .VerticalAlignment = -4108
        .Borders.LineStyle = 1
    End With
End Sub

On gagne déjà un peu de place et on évite le Select 😉

Pour le reste si tu joignais un fichier Excel allégé et anonymisé il serait plus facile pour nous de faire des tests.

 

[Crisky]

Re : Macros Partage et ralentissement : quels sont les bons usages ?

merci Staple1600
C'est vrai qu'il faut eviter les select et du coup j'avais pas pensé à ta methode
Je ne savais pas non plus que le center = -4108

Sinon pour mettre un fichier, c'est pas possible. Rendre anonyme le fichier ne serait pas simple tout en faisant en sorte qu'il reste comprehensible

Mais du coup j'ai trouvé une solution qui à tout changé

J'ai defini une variable tableau
et à cette variable j'ai attribué la valeur d'un range
J'ai fait ensuite fait les traitements de données et réaffecté les resultats dans une autre variable tableau et j'ai copié cette variable tableau dans un range d'une feuille

Je n'ai pas fini le developpement, il me reste la mise en forme mais au pire je perds 5 secondes

Resultat en mode exclusif
avt 10s
apres 1s

Resultat en mode partagé
avt 3,23mns
apres 3s

Vive la variable tableau

Quand j'aurais fini le developpement je mettrais en ligne le nouveau pour ceux que ca pourrais interresser plus tard

Cordialement
Crisky

 

[Staple1600]

Re : Macros Partage et ralentissement : quels sont les bons usages ?

Re

Quand j'aurais fini le developpement je mettrais en ligne le nouveau pour ceux que ca pourrais interresser plus tard
Cordialement
Crisky

Merci de ton partage.

A te relire donc plus tard avec ta version aboutie 😉

 

[Crisky]

Re : Macros Partage et ralentissement : quels sont les bons usages ?

Bon j'y suis arrivé
Avec le traitement de données dans des variables tableaux cela n'a plus rien à voir
Le code est quasi identique
Au lieu de traiter les cellules avec des boucles pour recueillir les infos, je traite les var tableaux
La partie du code qui a été ajouté ou changé :
report des données dans les variables tableaux
report des tableaux dans les feuilles
le total 5 lignes de codes en plus
en revanche toutes mes references celulles ont du etre modifiées


Resultat en partagé :
Avec la recherche des données dans les cellules : 3,23 mns
Avec les variables tableaux : 3s

La mise en forme avec l'astuce de staple permet de gagner des lignes mais aussi du temps à l'affichage 😎

Sub ActualisationActiviteQuotidenne()
Dim Lg As Integer, Col As Integer, Plan7(), Plan8(), Tb(), Result(), wb, ix, m, n, Jour
ReDim Result(1 To 300, 1 To 50)
Call DES
'report des données dans les variables tableaux
Plan7 = Feuil07.Range(Feuil07.Cells(1, 1), Feuil07.Cells(3400, 68)).Value
Plan8 = Feuil08.Range(Feuil08.Cells(1, 1), Feuil08.Cells(3400, 68)).Value
Tb = Feuil04.Range(Feuil04.Cells(6, 1), Feuil04.Cells(500, 19)).Value
'effacement des anciennes données de la feuille
Set wb = ActiveWorkbook.Worksheets(F_ActQuot): wb.Range("B7:AI306").Clear
'boucle de traitement des données du tableau Tb(tournées)
ix = 1
Call TypeTrn
For i = 1 To 300
    's'il n'y a pas de tournée sur la ligne fin de traitement du tableau tournée
    If Tb(i, 1) = Empty Then Exit For
    'si la tournée = tournée précédente passage à la ligne suivante
    If i <> 1 Then
        If Tb(i, 1) = Tb(i - 1, 1) Or Tb(i, 3) = TypeTrnRegul Then
            ix = ix - 1
            GoTo suite
        End If
    End If
    'affectation des données ds la tableau resultat
    Result(ix, 1) = Tb(i, 3) 'type trn
    Result(ix, 2) = Tb(i, 1) 'libellé trn
    'boucle de traitement des données
    'boucle sur les jours du mois
    For k = 8 To 68 Step 2
        Vartemp = Empty
        'boucle sur chacun sur les 2 plannings
        For l = 1 To 2
            'boucle sur les lignes du planning
            For j = PLPlan To 3396 Step 6
                'si le code trn de planning = code trn de trn incrmentation
                'traitement différent suivant le planning de la boucle
                If l = 1 Then
                    If UCase(Plan7(j + 2, k)) = UCase(Tb(i, 2)) Then Vartemp = Vartemp + 1
                Else
                    If UCase(Plan8(j + 2, k)) = UCase(Tb(i, 2)) Then Vartemp = Vartemp + 1
                End If
            Next j
        Next l
        'si vartemp n'est pas vide alors j'affiche result =vartemp sinon vide : traitement obligatoire sinon il y a des # dans le report des cellules
        If Vartemp <> Empty Then Result(ix, Int(k / 2)) = Vartemp Else Result(ix, Int(k / 2)) = Empty
    Next k
    'calcul de la somme des codes trn du mois
    For n = 4 To 34
        If Result(ix, n) <> Empty Then Result(ix, 3) = Result(ix, n) + Result(ix, 3)
    Next n
suite:
ix = ix + 1
Next i
ecart = i - ix
'report de la variable tableau ds la feuille
wb.Range("B7:AI306") = Result
'mise en forme
n = 1
DateMois = Worksheets(F_ActQuot).Cells(6, 5).Value

For m = 4 To 34
        Jour = 5 + Weekday(DateMois - (4 - m), vbMonday) * 2
        Set cel = Worksheets(F_Parametres).Range(Z_Param_JF).Find(DateMois - (4 - m), , xlValues, xlWhole)
        Do While Result(n, 1) <> Empty
            If Not cel Is Nothing Then
                Worksheets(F_ActQuot).Cells(n + PLActQuot - 1, m + 1).Interior.Color = RGB(204, 204, 204)
            Else
                If UCase(Result(n, m)) <> UCase(Tb(n + ecart, Jour)) And Result(n, 1) = TypeTrnExploit Then
                    If Result(n, m) > Tb(n + ecart, Jour) Then Worksheets(F_ActQuot).Cells(n + PLActQuot - 1, m + 1).Interior.ColorIndex = 46
                    If Result(n, m) < Tb(n + ecart, Jour) And Result(n, m) > 0 Then Worksheets(F_ActQuot).Cells(n + PLActQuot - 1, m + 1).Interior.ColorIndex = 44
                    If Result(n, m) < Tb(n + ecart, Jour) And Result(n, m) = Empty Then Worksheets(F_ActQuot).Cells(n + PLActQuot - 1, m + 1).Interior.ColorIndex = 3
                Else
                    If Weekday(DateMois - (4 - m), vbMonday) > 5 Then Worksheets(F_ActQuot).Cells(n + PLActQuot - 1, m + 1).Interior.ColorIndex = 37
                End If
            End If
            n = n + 1
        Loop
    
    n = 1
Next m
With wb.Range("B7").CurrentRegion
    .HorizontalAlignment = -4108: .VerticalAlignment = -4108
         .Borders.LineStyle = 1
End With
Call ACT
End Sub