Bonjour,

Je dois améliorer un fichier construit avec des fonctions Somme.si.ens à gogo.... c'est donc assez lent.

la macro est simple et consiste à les updater en gros . On choisi des scénarios et on fait des combinaisons de scénarios. 1 ==> 1 ; 1==> 2 1==>3.... 1==>6....... 6 ==> 6 , ca nous fait 36 combinaisons .
Clairement ca rame , mais c'est acceptable. Cependant durant la macro l'ecran ne repond plus , les performances sont à fond , clairement le pc de 4go de ram à du mal .

J'aimerais une solution ou des idées pour :
-stabiliser l'écran (trouver de la ressource), ralentir encore la macro ... je ne sais pas trop mais si vous avez des idées.
-Le temps de calcul est acceptable tout de même donc , je ne recherche qu'a stabiliser l'ecran et éventuellement des idées d'optimisation.

voici mon code :
Pensez-vous que l'on puisse éventuellement faire
Code : Sélectionner tout - Visualiser dans une fenêtre à part
masheet.enablecalculation = false
sur certaines feuilles que je ne souhaite pas updater durant la macro mais qui doivent l'etre à l'ouverture (une fois), car je sais que mon calculate s'applique à toute l'application.
J'ai été obligé de ralentir la macro en donnant la main au processeur durant le calcul , pour autant j'ai l'impression que ca ne le ralentit pas assez et que c'est quand même lourd pour windows.

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
 
...............
 
'Definition de la plage
        With thisworkbook.Worksheets("UNITES")
            Set AllRange_B = .Range(.Range("Sce_Base_Res").Offset(1), .Range("Sce_Base_Res").End(xlDown))
            Set AllRange_Adv = .Range(.Range("Sce_Adv_Res").Offset(1), .Range("Sce_Adv_Res").End(xlDown))
        End With
 
            'Calcul et copie des tableaux
        With thisworkbook.Worksheets("RiskFactors")
            For Each MyRange_B In AllRange_B
                Sce_B = Sce_B + 1: Sce_Adv = 0
                .Range("Sc_Base").Value = MyRange_B.Value
                DoEvents
                For Each MyRange_Adv In AllRange_Adv
                    Sce_Adv = Sce_Adv + 1
                    .Range("Sc_aDV").Value = MyRange_Adv.Value
                     Application.CalculateFull
                     Call Waiting
                        'Copie du tableau
                    Call CopyPaste(Sce_B, Sce_Adv)
                Next MyRange_Adv
            Next MyRange_B
        End With
    End If
 
        'Message d'alerte
    Application.StatusBar = "Calculs terminés"
    MsgBox ("Calculs terminés")
 
        'Optimisation : affichage des changements
    Application.ScreenUpdating = True
    Application.StatusBar = False
    Exit Sub
Errormana:
        'Optimisation : affichage des changements
    Application.ScreenUpdating = True
    Application.StatusBar = "Erreur lors du process"
    Application.StatusBar = False
    MsgBox ("Erreurs lors du process, les calculs ne sont pas terminés")
 
End Sub
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
    'Attendre que les formules se mettent à jour
Sub Waiting()
    Do
        DoEvents
    Loop Until Application.CalculationState = xlDone
End Sub
Merci d'avance