XL 2016 Calcul en boucle de valeurs cibles

[Guerouille]

Bonsoir à toutes et à tous,
Etant totalement inculte en VBA, j'aurais besoin d'automatiser des recherches de valeurs cibles sur les 365 jours de l'année 2025 (cf fichier en PJ).
Voici comment est construit le fichier :
-> Les colonnes C à AG contiennent des données d'entrée saisies manuellement (différentes pour chacun des jours de l'année)
-> Les colonnes AR à BE contiennent des formules de calcul, ainsi qu'une mise en forme via un code couleur "incolore / rouge" en fonction de leur comparaison par rapport à des valeurs de références (saisies manuellement dans les cases AR4 à BE4) : en fonction des données saisies dans les colonnes C à AG, certaines cases sont en rouge, et d'autres non
-> La colonne AI contient des cases vides, et l'objectif est d'identifier le nombre le plus grand possible qui laisse inchanger le code couleur

Exemple n°1 pour le 1er janvier (6e ligne du fichier) :
-> Toutes les cases sont incolores
-> Avec une valeur AI6 = 4105, le code couleur reste inchangé
-> Avec une valeur AI6 = 4106, la case BA6 vire au rouge

Exemple n°2 pour le 7 janvier (12e ligne du fichier) :
-> Les cases AY12, BA12 et BE12 sont en rouge, les autres cases sont incolores
-> Avec une valeur AI12 = 82, le code couleur reste inchangé
-> Avec une valeur AI12 = 83, la case AX12vire au rouge

Ma méthode est, pour un jour donné, de rentrer "au pif" des nombres compris entre 0 et 10000 pour savoir quelle est la case qui va virer au rouge en premier, et ensuite d'utiliser la fonction "Données -> Analyse scénarios -> Valeur cible" (ou bien le solveur) pour calculer la valeur avec précision.
Problème : cette manip prend du temps, et il faut la réitérer 365 fois pour chacun des jours de l'année 2025.
Par ailleurs, si je veux changer le jeu de données dans les cases C et AG et utiliser le jeu de données de l'année 2024, je suis bon pour tout recommencer ...

Pensez-vous qu'il soit possible d'automatiser tout ça ?

D'avance merci de tout cœur, et je reste à votre écoute si vous avez des questions (et surtout si mes explications n'étaient pas claires).

Laurent

 

[sylvanu]

Bonjour Guerouille, et bienvenu sur XLD,
Si sur une ligne, après avoir entrer une valeur "au pif" plusieurs cellules sont rouges, sur quelle cellule vous basez vous pour converger ?
( par ex ligne 10, valeur 0 : 4 cellules rouges, valeur 10000 : 5 cellules rouge. Dans ce cas que faire ? )
D'autres part la valeur cible peut elle être négative ?

Ajout :
"Just for the fun", un essai en PJ.
En première approche la valeur cible s'incrémente de 100 en 100 de 0 à 10000, en essayant de n'avoir qu'une case rouge par ligne.
Si le principe est bon on pourra toujours peaufiner;
( C'est assez long puisqu'on doit utiliser les cellules et non un tableau en VBA, j'ai donc mis la progression dans le statusbar )

 

[job75]

Bonjour Guerouille, sylvanu,

Voyez le fichier joint et la macro affectée au bouton :

Sub Valeur_Cible()
Dim t, Pcible As Range, Pcouleur As Range, i&, Pcoul As Range, a(), n&, c As Range, trouve As Boolean
t = Timer
Set Pcible = [AI6:AI370] 'à adapter
Set Pcouleur = [AR:AT,AW:BA,BE:BE] 'à adapter
Application.ScreenUpdating = False
For i = 1 To Pcible.Rows.Count
    Set Pcoul = Intersect(Pcouleur, Pcible(i).EntireRow)
    ReDim a(10000)
    trouve = False
    For n = 0 To 10000
        Pcible(i) = n
        For Each c In Pcoul
            If c.DisplayFormat.Interior.Color = vbRed Then a(n) = a(n) + 1
        Next c
        If n Then If a(n) > a(n - 1) Then trouve = True: Exit For
    Next n
    Pcible(i) = IIf(trouve, n - 1, "")
Next i
Application.ScreenUpdating = True
MsgBox Format(Timer - t, "0.00 \sec")
End Sub

Je me contente des valeurs de 0 à 10000 en colonne AI.

Chez moi la macro s'exécute en 1300 secondes.

A+

 

[job75]

Avec cette solution la macro s'exécute chez moi en 22 secondes, c'est maintenant acceptable :

Sub Valeur_Cible()
Dim t, Pcible As Range, Pcouleur As Range, i&, Pcoul As Range, sref, c As Range, trouve As Boolean, n&, s
t = Timer
Set Pcible = [AI6:AI370] 'à adapter
Set Pcouleur = [AR:AT,AW:BA,BE:BE] 'à adapter
Application.ScreenUpdating = False
For i = 1 To Pcible.Rows.Count
    Set Pcoul = Intersect(Pcouleur, Pcible(i).EntireRow)
    Pcible(i) = 0
    sref = 0
    For Each c In Pcoul
        If c.DisplayFormat.Interior.Color = vbRed Then sref = sref + 1
    Next c
    trouve = False
    For n = 0 To 10000 Step 100
        Pcible(i) = n
        s = 0
        For Each c In Pcoul
            If c.DisplayFormat.Interior.Color = vbRed Then s = s + 1
        Next c
        If s > sref Then trouve = True: Exit For
    Next n
    If trouve Then
        For n = n - 99 To n
            Pcible(i) = n
            s = 0
            For Each c In Pcoul
                If c.DisplayFormat.Interior.Color = vbRed Then s = s + 1
            Next c
            If s > sref Then Pcible(i) = n - 1: Exit For
        Next n
    Else
        Pcible(i) = ""
    End If
Next i
Application.ScreenUpdating = True
MsgBox Format(Timer - t, "0.00 \sec")
End Sub

 

[job75]

Pour aller plus vite il suffit d'ajouter des boucles :

Sub Valeur_Cible()
Dim t, Pcible As Range, Pcouleur As Range, i&, Pcoul As Range, sref, c As Range, trouve As Boolean, n&, s
t = Timer
Set Pcible = [AI6:AI370] 'à adapter
Set Pcouleur = [AR:AT,AW:BA,BE:BE] 'à adapter
Application.ScreenUpdating = False
For i = 1 To Pcible.Rows.Count
    Set Pcoul = Intersect(Pcouleur, Pcible(i).EntireRow)
    Pcible(i) = 0
    sref = 0
    For Each c In Pcoul
        If c.DisplayFormat.Interior.Color = vbRed Then sref = sref + 1
    Next c
    trouve = False
    For n = 0 To 10000 Step 1000
        Pcible(i) = n
        s = 0
        For Each c In Pcoul
            If c.DisplayFormat.Interior.Color = vbRed Then s = s + 1
        Next c
        If s > sref Then trouve = True: Exit For
    Next n
    If trouve Then
        For n = n - 900 To n Step 100
            Pcible(i) = n
            s = 0
            For Each c In Pcoul
                If c.DisplayFormat.Interior.Color = vbRed Then s = s + 1
            Next c
            If s > sref Then Exit For
        Next n
        For n = n - 90 To n Step 10
            Pcible(i) = n
            s = 0
            For Each c In Pcoul
                If c.DisplayFormat.Interior.Color = vbRed Then s = s + 1
            Next c
            If s > sref Then Exit For
        Next n
        For n = n - 9 To n
            Pcible(i) = n
            s = 0
            For Each c In Pcoul
                If c.DisplayFormat.Interior.Color = vbRed Then s = s + 1
            Next c
            If s > sref Then Pcible(i) = n - 1: Exit For
        Next n
    Else
        Pcible(i) = ""
    End If
Next i
Application.ScreenUpdating = True
MsgBox Format(Timer - t, "0.00 \sec")
End Sub

La macro s'exécute maintenant en 5,6 secondes.

 

[Guerouille]

Bonjour Sylvanu et Job75,
Merci à tous les deux pour vos contributions, et désolé pour mon manque de réactivité quant à ma réponse ...

-> Sylvanu, je n'ai pas eu le temps de répondre à tes questions, car Job75 avait déjà posté et proposé une macro qui correspondait parfaitement à mes besoins.
J'ai toutefois récupéré ton code pour intégrer la progression dans le statusbar : c'est bien utile pour savoir si on a le temps d'aller prendre ou non un café lorsque la macro s'exécute !!

-> Job75, ta version "Valeurs-cible-multiples(2).xlsm" est exactement ce qu'il me fallait : j'ai simplement étendu jusqu'à 50000 les valeurs à tester, pour que ça calcule les 365 jours de l'année (en limitant à 10000, certains jours de l'année restaient sans résultats). J'ai constaté avec soulagement que ça n'augmentait pas de manière déraisonnable le temps d'exécution de la macro.

Encore merci de vous être penché de manière si rapide et efficace sur mon problème : vous m'avez fait gagner un temps précieux ! 👍

A bientôt

Laurent 😊

 

[job75]

Bonjour Guerouille, le forum,

J'ai toutefois récupéré ton code pour intégrer la progression dans le statusbar : c'est bien utile pour savoir si on a le temps d'aller prendre ou non un café lorsque la macro s'exécute !!

Sur l'exemple ma macro s'exécute en 5 ou 6 secondes, on n'a pas le temps de prendre un café 😀

j'ai simplement étendu jusqu'à 50000 les valeurs à tester, pour que ça calcule les 365 jours de l'année (en limitant à 10000, certains jours de l'année restaient sans résultats). J'ai constaté avec soulagement que ça n'augmentait pas de manière déraisonnable le temps d'exécution de la macro.

Sur l'exemple le maximum de la colonne AI est 9155 donc on utilise la boucle For n = 0 To 10000 Step 1000

Avec un maximum de 49500 on utilisera For n = 0 To 50000 Step 1000 ça ne prendra pas beaucoup plus de temps puisque le pas est de 1000.

A+