Correction de "bug" sur macro VBA valeur cible

Le 13/03/2023 à 09:30

Bonjour à toutes et tous,

J'ai un premier code VBA qui me permet d'exécuter des calculs en utilisant la fonction valeur cible de Excel; ce code ci-dessous fonctionne très bien mais avec des temps d'exécution longs :

Sub VAM1()

     'calculer VAM (valeur article moyen avec la fonction valeur cible de Excel)
Dim i As Integer

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

  i = 0
  With ThisWorkbook.Worksheets(4)

  Do While .Cells(i + 30, 29).Value = "Panier calcul"

        .Cells(i + 31, 29).GoalSeek Goal:=.Cells(i + 31, 24).Value, ChangingCell:=.Cells(i + 31, 33)
        .Cells(i + 32, 29).GoalSeek Goal:=.Cells(i + 32, 24).Value, ChangingCell:=.Cells(i + 32, 33)
        .Cells(i + 33, 29).GoalSeek Goal:=.Cells(i + 33, 24).Value, ChangingCell:=.Cells(i + 33, 33)
        .Cells(i + 34, 29).GoalSeek Goal:=.Cells(i + 34, 24).Value, ChangingCell:=.Cells(i + 34, 33)
        .Cells(i + 35, 29).GoalSeek Goal:=.Cells(i + 35, 24).Value, ChangingCell:=.Cells(i + 35, 33)
        .Cells(i + 36, 29).GoalSeek Goal:=.Cells(i + 36, 24).Value, ChangingCell:=.Cells(i + 36, 33)
        .Cells(i + 37, 29).GoalSeek Goal:=.Cells(i + 37, 24).Value, ChangingCell:=.Cells(i + 37, 33)
        .Cells(i + 38, 29).GoalSeek Goal:=.Cells(i + 38, 24).Value, ChangingCell:=.Cells(i + 38, 33)
        .Cells(i + 39, 29).GoalSeek Goal:=.Cells(i + 39, 24).Value, ChangingCell:=.Cells(i + 39, 33)
        .Cells(i + 40, 29).GoalSeek Goal:=.Cells(i + 40, 24).Value, ChangingCell:=.Cells(i + 40, 33)
        .Cells(i + 41, 29).GoalSeek Goal:=.Cells(i + 41, 24).Value, ChangingCell:=.Cells(i + 41, 33)
        .Cells(i + 42, 29).GoalSeek Goal:=.Cells(i + 42, 24).Value, ChangingCell:=.Cells(i + 42, 33)
        .Cells(i + 43, 29).GoalSeek Goal:=.Cells(i + 43, 24).Value, ChangingCell:=.Cells(i + 43, 33)
        .Cells(i + 44, 29).GoalSeek Goal:=.Cells(i + 44, 24).Value, ChangingCell:=.Cells(i + 44, 33)
        .Cells(i + 45, 29).GoalSeek Goal:=.Cells(i + 45, 24).Value, ChangingCell:=.Cells(i + 45, 33)

        i = i + 23
    Loop

  End With

     Calculate

       Application.ScreenUpdating = True
     Application.Calculation = xlCalculationAutomatic

    Range("A1").Select

End Sub

J'ai essayé d'optimiser ce code pour réduire les temps d'exécutions avec le code ci dessous mais il bug sur cette ligne :

" cellsToChange(i).GoalSeek goalValues(i), .Cells(30 + (i - 1) * 23, 33) "

Le code approche optimisée :

Sub VAMOPTIMISER()

Dim i As Integer
Dim cellsToChange As Variant
Dim goalValues As Variant

Application.EnableEvents = False
Application.ScreenUpdating = False

timerDebut = Timer

With ThisWorkbook.Worksheets(4)

cellsToChange = Array(.Range("AI32:AI45"), .Range("AJ32:AJ45"), .Range("AK32:AK45"))
goalValues = Array(.Range("X32:X45").Value, .Range("Y32:Y45").Value, .Range("Z32:Z45").Value)

For i = 1 To UBound(cellsToChange)
cellsToChange(i).GoalSeek goalValues(i), .Cells(30 + (i - 1) * 23, 33)
Next i
End With

Calculate

Application.EnableEvents = True
Application.ScreenUpdating = True

Range("A1").Select

End Sub

Pourriez vous m'aider à corriger mon code et ou me proposer une autre piste d'optimisation ?

Merci beaucoup

Très cordialement

Hugues

Le 13/03/2023 à 18:44

Bonjour

J'ai essayé d'optimiser ce code pour réduire les temps d'exécutions avec le code ci dessous mais il bug sur cette ligne :

Premier code : vous mettez CALCULATE juste en dessous du END WITH alors que plus bas vous repassez en calcul automatique. Vous pouvez déjà essayer en supprimant cette instruction.

Dans votre deuxième code, rajouter l'instruction pour mise en calcul manuel puis sur automatique à la fin du code et supprimer le Calculate

Le 13/03/2023 à 20:31

re, ce sont des cellules, donc l'utilisation d'une matrice ne fonctionne pas.

          Set CellsToChange = .Range("AI32:AK45")
     ' goalValues = Array(.Range("X32:X45").Value, .Range("Y32:Y45").Value, .Range("Z32:Z45").Value)     '10 cellules vers gauche

          For iC = 1 To CellsToChange.Columns.Count     'boucle les colonnes
               For iL = 1 To CellsToChange.Rows.Count     ' et les lignes
                    i = i + 1
                    MsgBox "CellTo change : " & .CellsToChange(i, j).Address & vbLf & "Valeur : " & .CellsToChange(i, j).Offset(, -10).Address & vbLf & "3ième cellule, i= " & i & vbLf & "ligne & colonne :  " & .Cells(30 + (i - 1) * 23, 33).Address(1, 1, xlR1C1)
                    .CellsToChange(i, j).GoalSeek .CellsToChange(i, j).Offset(, -10).Value, .Cells(30 + (i - 1) * 23, 33)
               Next 
         Next
Le 16/03/2023 à 14:08

Bonjour Dan, Bart, toutes et tous

Dan et Bart merci pour vos réponses.

En m'appuyant sur vos remarques et d'autres recherches j'ai pu construire le code ci dessous et également dans le fichier exemple joint.

La macro est fonctionnelle, je reviens vers vous pour savoir ce qui peut être optimisé.

Le temps d'exécution reste très long, à votre avis cela peut être du à la construction de mon code ou alors à la volumétrie des calculs à effectuer et de la complexité de la fonction valeur cible d'Excel en elle même.

Merci

Très cordialement

Hugues

7vam-01.xlsm (113.45 Ko)
Sub VAM()

    'calculer VAM (valeur article moyen avec la fonction valeur cible de Excel)
    ' Panier calcul : cellule contenant la formule AC Cellule a definir
    ' Objectif Panier : cellule contenant la valeur que la formule doit atteindre X Valeur a atteindre
    ' VAM cellule contenant la variable a modifier AG Cellule a modifier

    Dim timerDebut As Double

    timerDebut = Timer

    ' Désactiver les fonctionnalités temporaires pour améliorer la performance
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    ' Appel de la fonction personnalisée pour les différentes plages de lignes
    PerformGoalSeek 31, 45
    PerformGoalSeek 54, 68
    PerformGoalSeek 77, 91
    PerformGoalSeek 100, 114
    PerformGoalSeek 123, 137
    PerformGoalSeek 146, 160
    PerformGoalSeek 169, 183
    PerformGoalSeek 192, 206
    PerformGoalSeek 215, 229
    PerformGoalSeek 238, 252
    PerformGoalSeek 261, 275
    PerformGoalSeek 284, 298

    ' Réactiver les fonctionnalités après l'exécution du code
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic

    Range("A1").Select

    MsgBox "Durée : " & (Timer - timerDebut) & " sec."

End Sub

' Fonction personnalisée pour appliquer GoalSeek sur une plage de lignes
Sub PerformGoalSeek(startRow As Long, endRow As Long)
Dim i As Long
Dim errorRows As String

For i = startRow To endRow
    On Error Resume Next
    Range("AC" & i).GoalSeek Goal:=Range("X" & i).Value, ChangingCell:=Range("AG" & i)
    If Err.Number <> 0 Then
        errorRows = errorRows & i & ", "
        Err.Clear
    End If
Next i

If Len(errorRows) > 0 Then
    errorRows = Left(errorRows, Len(errorRows) - 2) ' Supprimer la virgule et l'espace en trop
    MsgBox "Les lignes suivantes ont généré des erreurs lors de l'exécution de la fonction PerformGoalSeek: " & errorRows, vbExclamation
End If
End Sub
Le 16/03/2023 à 15:16

re,

ce sont les formules (indirect) des colonnes Q:R qui causent ce problème. Si vous videz ces colonnes, tout est presque immédiat.

Vous voulez faire quoi avec ces formules ?

Le 16/03/2023 à 15:29

Bonjour

Déjà deux instructions à supprimer --> Application.enableevents false et True. Elles ne servent à rien ici.
Après ce qui fait ralentir le code c'est la ligne ci-dessous :

Range("AC" & i).GoalSeek Goal:=Range("X" & i).Value, ChangingCell:=Range("AG" & i)

Cela prend déjà 35 sec rien que sur l'instruction "PerformGoalSeek 31, 45"

Faite du pas à pas avec les touches POMME + SHIFT + i (puisque je pense que vous êtes sous MAC), vous verrez directement

Crdlt

Edit @Bart
là c'est dingue !!!!. Je me demande comment excel voit cela sachant que l'on est en mode manuel dans le code. Si on se met en mode manuel et que l'on suspend l'instruction de remise en auto, la lenteur est identique.

Le 16/03/2023 à 19:58

Bonsoir Bart, et Dan, Toutes et tous,

Merci à vous Bart et Dan de continuez à suivre mon post et de me répondre.

Je vais de nouveau mettre en pratique vos conseils et vous en ferez un retour.

Bart, pour les indirect tel que INDIRECT("TABCA[CODE_MAG]")=$A8, dans le fichier complet cela permet de faire une recherche dans des données mises sous forme de tableau. Je passe par indirect pour que les références soit absolues et figées pour que lorsqu'on copie, colle, fait glisser etc. les formules soit figées sur certains de leur élément notamment celle faisant appel aux entêtes des données en tableau. Je ne connais pas d'autre moyen pour ce faire au même titre que l'on utilise $ sur les références de cellules. Mais peut être connaissez vous une autre approche. Je vais regarder pour ne plus faire appel à indirect en écrivant les formules pour chaque cellule (cela va certainement me demander un peu de temps, ou alors je vais réfléchir via une syntaxe en cherchant remplacer).

En tous cas déjà c'est mieux qu'au début et vous m'avez dans le bon sens forcé à réfléchir.

A suivre

Très cordialement

Hugues

Le 19/03/2023 à 16:33

Bonjour Dan, Bart, toutes et tous,

Je cloture ce post.

Merci Dan et Bart pour votre aide.

Je le mets comme résolu et Bart de nouveau je vous remercie car effectivement j'ai appliqué les conseils mutuels de Dan et Bart, mais la cause principale du ralentissement était bien l'utilisation de INDIRECT

A bientôt

Très cordialement

Hugues

Rechercher des sujets similaires à "correction bug macro vba valeur cible"