Gros Lag/Freez dans l'exécution d'une macro complexe
Bonjour a tous,
c'est ma première fois a poster un sujet car je n'ai pas réussi a trouver de solution efficace malgré le puits d'information d'internet.
Voila mon soucis, j'ai une feuille excel qui calcul automatiquement les tassements de terrain en fonction des descentes de charges, de la contrainte du sol, des dimensions des fondations mais aussi en extrapolant des données d'une étude de sol (Pénétromètre et tarière)
Ma macro fonctionne correctement. les tassements se font efficacement quand j'ouvre le fichier excel.
Mais si j'ai le malheur de laisser le fichier un peu tranquille et que je revient dessus pour lancer ma macro, la feuille se met alors en mode lag...
Sur le gestionnaire de tache on se rend compte que la feuille travail (16% CPU et 10% GPU) et effectivement si j'ai la patience la macro avance tout doucement et avec un peu de chance elle finira par passer complètement.
Dans le cas ou ca marche pas, je kill le logiciel, je relance la feuille et si je lance les tassements tout de suite la macro s'exécute sans problème ni ralentissement...
avez vous une idée de ce qui ce passe dans ma feuille pour faire ça ?
Bonjour
plutôt un fichier example
( sans données personnel)
merci
Je peux pas divulguer ce fichier Excel pour raison professionnel.
et je n'ai pas réussi a reproduire le problème sur d'autre feuille.
Ma question est surtout de savoir ce qui pourrais entrainer ce Lag, si ca se trouve c'est pas excel mais peut etre un sous-composant windows qui charge le processus excel...
Comme je vous ai dit ma macro est fonctionnel, si je l'exécute au démarrage de excel, pas de soucis. si j'attend un peu ça Lag et si j'attend encore un peu Excel devient ingérable.
Mon fichier est quand même un gros fichier (5Mo)
Bon,
j'ai pas trouver le problème mais j'ai solutionner le problème..
Ma feuilles étant très grosse et complexe, ma macro exécute et bouge beaucoup d'information.
J'ai fais plusieurs switch entre calcul automatique/manuel a l'intérieur de ma macro (quand j'en avais besoin en gros et pas plus).
J'ai également utilisé la fonction ActiveWorkbook.Save & Worksheets("Rendu A3").Activate afin d'être sur que ma macro s'exécutait au bon endroit.
Je me retrouve avec une macro beaucoup plus stable, (pas de freez depuis 30 minute) donc je pense que le sujet est résolu...
Mais je voie toujours pas pourquoi il y avait des Lags avant...
J'ai parlé trop vite...
Sujet toujours pas résolu....
du moins pour moi, sans test je n'ai pas de reponses
Bonjour,
Le contenu des feuilles, on s'en fiche mais les macros ça nous donnerai surement déjà quelques idées...
A+
Ci dessous la macro associé a un bouton.
Sub Appel_tassement_general()
ActiveWorkbook.Save
Worksheets("Rendu A3").Activate
Sheets("Rendu A3").Select
Call Calcul_tassements_C1
Call Calcul_tassements_C2
Call Calcul_tassements_C3
Call Calcul_tassements_C4
Call Calcul_tassements_C5
Call Calcul_tassements_C6
Call Calcul_tassements_C7
Call Calcul_tassements_C8
Call Calcul_tassements_C9
Call Calcul_tassements_C10
Sheets("Rendu A3").Select
ActiveWorkbook.Save
Sheets("Synthèse EXE+PRO").Visible = False
Sheets("Tassements").Visible = False
End SubCi dessous le code du tassements C1 :
Sub Calcul_tassements_C1()
'On Error GoTo Fin
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlManual
Dim Name As String
Dim Statique As Boolean
Dim i, f, g As Integer
Name = ThisWorkbook.Name
Worksheets("Rendu A3").Activate
Sheets("Synthèse EXE+PRO").Visible = True
Sheets("Tassements").Visible = True
Sheets("Synthèse EXE+PRO").Select
Worksheets("Synthèse EXE+PRO").Activate
'----------------------------------------------------------------
''Vérif statique
For i = 1 To 30
Cells(i, 7).Select
verif = Left(ActiveCell.Value, 1)
If verif = "S" Then
Statique = True
NumStatique = Right(ActiveCell.Value, 1)
Exit For
End If
Next i
'----------------------------------------------------------------
'----------------------------------------------------------------
'Semelles filantes min
If Sheets("Rendu A3").Range("AI4").Value <> "" And Sheets("Rendu A3").Range("AN4").Value <> "" And Sheets("Rendu A3").Range("O4").Value + Sheets("Rendu A3").Range("Y4").Value + Sheets("Rendu A3").Range("AS4").Value <> 0 Then
Penetro = Sheets("Rendu A3").Range("AI4").Value
NumPenetro = Right(Penetro, 1)
Tariere = Sheets("Rendu A3").Range("AN4").Value
Profondeur = Sheets("Rendu A3").Range("AS4").Value
Largeur = Sheets("Rendu A3").Range("Y4").Value
Longueur = Sheets("Rendu A3").Range("AD4").Value
Charge = Sheets("Rendu A3").Range("O4").Value
If Profondeur > 0 Then
Profondeur = -Profondeur
End If
For i = 1 To 500
Cells(i, 1).Select
If ActiveCell.Value = Penetro Then
Niveau_penetro = Cells(i, 2).Value
Exit For
End If
Next i
For i = 1 To 500
Cells(i, 10).Select
If ActiveCell.Value = Tariere Then
Niveau_tariere = Cells(i, 11).Value
Exit For
End If
Next i
If Niveau_tariere <> Niveau_penetro Then
Reglage_prof = InputBox("La tarrière et le pénétro du Rep C.1 n'ont pas la même référence terrain, merci de m'indiquer la différence de niveau (en m) a ajouter au niveau de la tarrière pour faire corréler la tarrière vis a vis du pénétro. (valeur négative accepter) ", "Recalibrage de niveau")
Reglage_prof = Val(Reglage_prof)
Niveau_tariere = Niveau_tariere + Reglage_prof
Else
Reglage_prof = 0
End If
For i = 1 To 500
Cells(i, 10).Select
If ActiveCell.Value = Tariere Then
Nb = 0
For f = 1 To 500
If Cells(i + f, 11).Value <> "" Then
Nb = Nb + 1
Else
Exit For
End If
Next f
Nb = Nb + 1
For g = 1 To Nb
If Cells(i + g, 11).Value <> "" Then
If Cells(i + g, 11).Value > -Profondeur - Reglage_prof Then
' MsgBox (Cells(i + g, 11).Value)
sol1 = LCase(Cells(i + g, 13).Value)
sable = InStr(1, sol1, "sabl")
If sable = 0 Then
sable = 1000
End If
argile = InStr(1, sol1, "argil")
If argile = 0 Then
argile = 1000
End If
rocher = InStr(1, sol1, "roche")
If rocher = 0 Then
rocher = 1000
End If
limon = InStr(1, sol1, "limon")
If limon = 0 Then
limon = 1000
End If
var1 = WorksheetFunction.Min(sable, argile, rocher, limon, 800)
If var1 = sable Then
sol1 = "sable"
Else
If var1 = argile Then
sol1 = "argile"
Else
If var1 = limon Then
sol1 = "limon"
Else
If var1 = rocher Then
sol1 = "rocher"
Else
sol1 = InputBox("Le type de sol pour la semelles filantes mini C.1 n'as pas pu être défini automatiquement, Merci de nous indiquer de quelle type de sol il s'agit (sable, limon, rocher, argile):", "type de sol sous fondation")
'GoTo Fin
End If
End If
End If
End If
'sol1 = PremierMot(Cells(i + g, 13).Value)
Exit For
End If
Else
sol1 = LCase(Cells(i + g - 1, 13).Value)
sable = InStr(1, sol1, "sabl")
If sable = 0 Then
sable = 1000
End If
argile = InStr(1, sol1, "argil")
If argile = 0 Then
argile = 1000
End If
rocher = InStr(1, sol1, "roche")
If rocher = 0 Then
rocher = 1000
End If
limon = InStr(1, sol1, "limon")
If limon = 0 Then
limon = 1000
End If
var1 = WorksheetFunction.Min(sable, argile, rocher, limon, 800)
If var1 = sable Then
sol1 = "sable"
Else
If var1 = argile Then
sol1 = "argile"
Else
If var1 = limon Then
sol1 = "limon"
Else
If var1 = rocher Then
sol1 = "rocher"
Else
sol1 = InputBox("Le type de sol pour la semelles filantes mini C.1 n'as pas pu être défini automatiquement, Merci de nous indiquer de quelle type de sol il s'agit (sable, limon, rocher, argile):", "type de sol sous fondation")
'GoTo Fin
End If
End If
End If
End If
'sol1 = PremierMot(Cells(i + g, 13).Value)
Exit For
End If
Next g
Exit For
End If
Next i
'----------------------------------------------------------------
'Facteur Qd
If Left(Penetro, 1) = "D" Then
Diviseur_Qd = Sheets("Synthèse EXE+PRO").Range("V2").Value
Else
Diviseur_Qd = Sheets("Synthèse EXE+PRO").Range("W2").Value
End If
'Fin facteur Qd
'----------------------------------------------------------------
'Elancement
Sheets("Tassements").Select
Sheets("Tassements").Range("AB11").Value = Largeur
Sheets("Tassements").Range("AB17").Value = Profondeur
Sheets("Tassements").Range("AB23").Value = Charge
Elancement = Longueur / (Largeur / 100)
If Elancement <= 2 Then
Elancement = 2
Else
If Elancement <= 3 Then
Elancement = 3
Else
If Elancement <= 5 Then
Elancement = 5
Else
Elancement = 20
End If
End If
End If
pas = 0
For i = 1 To 4
Cells(39, 31 + i + pas).Select
If ActiveCell.Value = Elancement Then
Sheets("Tassements").Range("AB41").Value = Cells(41, 31 + i + pas).Value
Sheets("Tassements").Range("AB43").Value = Cells(43, 31 + i + pas).Value
Exit For
End If
pas = pas + 3
Next i
Sheets("Synthèse EXE+PRO").Select
'----------------------------------------------------------------
'Nature du sol sous la fondation
If sol1 = "argile" Then
Sheets("Tassements").Range("AV56").Value = 0.67
End If
If sol1 = "limon" Then
Sheets("Tassements").Range("AV56").Value = 0.5
End If
If sol1 = "sable" Then
Sheets("Tassements").Range("AV56").Value = 0.33
End If
If sol1 = "rocher" Then
Sheets("Tassements").Range("AV56").Value = 0.67
End If
'-----------------------------------------------------------------
'QaELS
For i = 1 To 500
Cells(i, 1).Select
If ActiveCell.Value = Penetro Then
pas = 0
For f = 1 To 500
If Cells(i + f, 3).Value <> "" Then
'MsgBox (Cells(i + f, 3).Value)
'MsgBox (-Sheets("Tassements").Range("U68").Value)
If Cells(i + f, 3).Value >= -Sheets("Tassements").Range("U70").Value Then
'MsgBox (Cells(i + f, 3).Value)
'MsgBox (-Sheets("Tassements").Range("U68").Offset(pas, 0).Value)
If Cells(i + f, 3).Value = -Sheets("Tassements").Range("U70").Offset(pas, 0).Value Then
'MsgBox (Cells(i + f + 1, 3).Value)
' If Cells(i + f + 1, 3).Value <> "" Then
'MsgBox (Sheets("Tassements").Range("F70").Offset(pas, 0).Value)
If Sheets("Tassements").Range("F70").Offset(pas, 0).Value <> "" Then
'MsgBox (Cells(i + f, 4).Value)
Sheets("Tassements").Range("N70").Offset(pas, 0).Value = Cells(i + f, 4).Value / Diviseur_Qd
Sheets("Tassements").Range("N70").Offset(pas, 1).Value = Cells(i + f, 4).Value
pas = pas + 2
Else
Exit For
End If
' Else
' Exit For
' End If
Else
If Sheets("Tassements").Range("F70").Offset(pas, 0).Value <> "" Then
'MsgBox (Cells(i + f, 4).Value)
Sheets("Tassements").Range("N70").Offset(pas, 0).Value = ((Cells(i + f, 4).Value + Cells(i + f - 1, 4).Value) / 2) / Diviseur_Qd
Sheets("Tassements").Range("N70").Offset(pas, 1).Value = ((Cells(i + f, 4).Value + Cells(i + f - 1, 4).Value) / 2)
pas = pas + 2
Else
Exit For
End If
End If
End If
Else
For g = 1 To 500
If Sheets("Tassements").Range("F70").Offset(pas, 0).Value <> "" Then
If valeur_min > 0 Then
Sheets("Tassements").Range("N70").Offset(pas, 0).Value = valeur_min
Sheets("Tassements").Range("N70").Offset(pas, 1).Value = valeur_min * Diviseur_Qd
Else
valeur_min = Cells(i + f - 1, 4).Value / Diviseur_Qd
Sheets("Tassements").Range("N70").Offset(pas, 0).Value = valeur_min
Sheets("Tassements").Range("N70").Offset(pas, 1).Value = valeur_min * Diviseur_Qd
End If
pas = pas + 2
Else
Exit For
End If
Next g
Exit For
End If
Next f
Exit For
End If
Next i
'-----------------------------------------------------------------
'type de sol
For i = 1 To 500
Cells(i, 10).Select
If ActiveCell.Value = Tariere Then
For g = 1 To 500
If Sheets("Tassements").Range("F70").Offset((g - 1) * 2, 0).Value <> "" Then
If Cells(i, 18).Value < -Sheets("Tassements").Range("U70").Offset((g - 1) * 2, 0).Value - Reglage_prof Then
If Sheets("Tassements").Range("N70").Offset((g - 1) * 2, 0).Value >= 1 Then
Sheets("Tassements").Range("H70").Offset((g - 1) * 2, 0).Value = "rocher"
Else
If Sheets("Tassements").Range("H70").Offset((g - 1) * 2, 0).Address = Sheets("Tassements").Range("H70").Address Then
valsol = InputBox("La tarière associé à C1 n'est pas assez profonde, merci de renseigner ici le type de sol (argile, limon, sable, rocher) :", "type de sol sous fondation")
valsol = LCase(valsol)
Sheets("Tassements").Range("H70").Offset((g - 1) * 2, 0).Value = valsol
Else
Sheets("Tassements").Range("H70").Offset((g - 1) * 2, 0).Value = Sheets("Tassements").Range("H70").Offset((g - 1) * 2 - 2, 0).Value
End If
End If
Else
For f = 1 To 500
' If Cells(i + f, 11).Value <> "" Then
'MsgBox (Sheets("Tassements").Range("U70").Offset(pas, 0).Value)
If Cells(i + f, 11).Value >= -Sheets("Tassements").Range("U70").Offset((g - 1) * 2, 0).Value - Reglage_prof Then
sol2 = LCase(Cells(i + f, 13).Value)
sable = InStr(1, sol2, "sabl")
If sable = 0 Then
sable = 1000
End If
argile = InStr(1, sol2, "argil")
If argile = 0 Then
argile = 1000
End If
rocher = InStr(1, sol2, "roche")
If rocher = 0 Then
rocher = 1000
End If
limon = InStr(1, sol2, "limon")
If limon = 0 Then
limon = 1000
End If
var2 = WorksheetFunction.Min(sable, argile, rocher, limon, 800)
If var2 = sable Then
sol2 = "sable"
Else
If var2 = argile Then
sol2 = "argile"
Else
If var2 = limon Then
sol2 = "limon"
Else
If var2 = rocher Then
sol2 = "rocher"
Else
sol2 = InputBox("Le type de sol pour la semelles filantes mini C.1 n'as pas pu être défini automatiquement, Merci de nous indiquer de quelle type de sol il s'agit (sable, limon, rocher, argile):", "type de sol sous fondation")
'GoTo Fin
End If
End If
End If
End If
Sheets("Tassements").Range("H70").Offset((g - 1) * 2, 0).Value = sol2
Exit For
End If
' Else
' Sheets("Tassements").Range("H70").Offset((g - 1) * 2, 0).Value = Sheets("Tassements").Range("H70").Offset((g - 1) * 2 - 2, 0).Value
'
' Exit For
' End If
Next f
' pas = pas + 2
End If
Else
Exit For
End If
Next g
Exit For
End If
Next i
Application.Calculation = xlAutomatic
Sheets("Rendu A3").Select
Sheets("Rendu A3").Range("AX4").Value = Sheets("Tassements").Range("AL77").Value
Sheets("Rendu A3").Range("BC4").Value = Sheets("Tassements").Range("AR77").Value
Else
Texte1 = "Semelles filantes Mini C.1"
End If
'----------------------------------------------------------------
'----------------------------------------------------------------
'Semelles filantes min FIN
'Fin:
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End SubC'est inbuvable comme ça, mais si vous voyez des choses qui cloche...
Je rappel la macro s'exécute correctement quand le excel vient d'être ouvert...
si j'attend il freez un peu sans bloqué
si j'attend encore plus il freez et la plus moyen de continué ==> gestionaire de tache et kill processus...
Merci d'avance de vos retours.
Bon, je pense avoir trouvé le problème. et c'est très formateur pour moi.
toutes mes variables n'étaient pas déclaré correctement ce qui entrainait surement une monter en charge de la ram alloué a chaque variable.
c'est la première fois que mon code était si volumineux et j'avais la mauvaise manie de ne pas déclaré correctement. Jamais j'aurais pensé que ca pouvais saturé excel d'avoir des variables non déclaré.
Enfin bref, le retour a la base y a que ça de vrai !
Merci en tout cas pour vos réponses, cela m'a permis également de me remettre en question sur mon propre code.
Et je pense que cela pourrai servir a d'autre utilisateur qui ont eu comme moi des crash Excel !
Bonjour,
Ceci n'est pas une bonne déclaration :
Dim i, f, g As IntegerIl faut faire :
Dim i As Integer, f As Integer, g As Integerou :
Dim i%, f%, g%... Chaque variable doit être typée individuellement. Ceci est également valable pour les variables déclarées en tête de module,
Quand vous en avez un grand nombre utilisez ! (as single) ou # (as double)
A+
Au minimum vous devriez nous passer tout le classeur avec toutes les macros : Si on peut (à l'extrème rigueur se passer des données, on ne peut rien faire avec juste une macro, surtout s'il n'y a pas de déclaration ou si les déclarations sont collectives. (en tête de module)
Je vous encourage vivement à essayer de fournir un classeur débarrassé d'éléments confidentiels et avec suffisamment de données pour qu'on puisse un peu optimiser ce code qui est vraiment rudimentaire : VBA n'est pas "no limit !" Il est loin le temps ou Microsft préconisait des macros d'un écran, mais bien que nulle part les limites extrèmes ne soient énoncées... (Ce serait trop difficile à préciser, ça dépend fortement de l'optimisation)
...Si vous avez 12 macros de ce type pas étonnant que votre truc YRAME... 10 fois 330 lignes non optimisées ça fait 3300 lignes : Moi je considère qu'à partir de 3000 lignes de VBA de ce type un classeur est susceptible de déclarer forfait sans préavis à tout moment !
A+