Automatiser un calcul par tâtonnement

Magic_Doctor · 28 Décembre 2017

Bonjour,

Je voudrais automatiser le calcul suivant qui ne peut se faire que manuellement (je n'ai malheureusement pas pu trouver de formule qui puisse me le donner).
Dans la colonne "N" (normalement occulte) il y a une série de valeurs. Chaque valeur est déterminée par un pourcentage (γ --> cellule O9).
Pour chaque pourcentage (choisi en O9) je dois trouver une valeur N selon les critères suivants :
- on choisit 3 décimales après la virgule (on n'y touche plus par la suite)
- N ∈ [1,45 ; 2,35] (on n'ira pas au-delà de 2 décimales après la virgule)
- on cherche N jusqu'à obtenir le plus grand pourcentage possible apparaissant dans la cellule T9 (police rouge)

Un vrai pensum !

J'ai essayé avec le Solveur mais, n'étant pas habitué à l'utiliser, ça n'a pas marché.

Comment pourrait-on s'y prendre ?

job75 · 29 Décembre 2017

Bonjour Magic_Doctor, le forum,

La macro dans le fichier joint :

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'---maximise la cible T9---
If Target.Address <> "$N$14" Then Exit Sub
Dim inf#, sup#, cible As Range, r As Range, imin&, mem, vmax, i&
Cancel = True
inf = 1.45: sup = 2.35 'adaptables
Set cible = [T9] 'adaptable
Set r = [M16:M47] 'adaptable
r(0, 2) = inf 'N15
imin = inf * 100
mem = [Gamma1] 'mémorise la valeur de O9
For Each r In r
  [Gamma1] = r 'modification de O9
  vmax = 0
  Application.ScreenUpdating = False
  For i = imin To sup * 100
    r(1, 2) = i / 100 'modification en colonne N
    If IsNumeric(cible) Then If cible > vmax Then vmax = cible: imin = i
  Next i
  r(1, 2) = imin / 100 'valeur retenue en colonne N
Next r
[Gamma1] = mem
End Sub

Chez moi sur Win 10 Excel 2013 la macro s'exécute en 9 secondes.

Edit : j'ai ajouté le test If IsNumeric(cible) Then car cible peut prendre une valeur d'erreur.

Bonne journée.

Magic_Doctor · 29 Décembre 2017

Bonjour job,

Là, vraiment, un grand moment.
Après avoir échoué avec le Solveur, j'avais tenté ceci :

[T9].GoalSeek Goal:=100, ChangingCell:=CelN

"CelN" étant la cellule de la colonne N dont on cherche la valeur par tâtonnement.
J'obtenais des résultats vraiment très curieux.

Inutile de te dire qu'avant de double-cliquer sur la cellule "N", j'ai allumé une cigarette, inspiré une grande bouffée, croisé les doigts et... Magic! ¡Magia! L'incroyable se déroulait sous mes yeux. Un vrai thriller !

Mais, quand même, 9'' c'est long !
Ah ! Ah ! Là je déconne vraiment.

Merci 1000 fois job pour avoir résolu ce problème qui me permet d'avancer dans la détermination des masses volumiques, pierres angulaires de toutes dilutions, permettant de réaliser simplement sur une paillasse, avec tout juste une seringue de 1 mL, des mélanges dont les concentrations sont en masse/masse (il faut aussi avoir recours à d'autres formules que j'avais développées) sans devoir passer par une balance ou un potard.

Compare les résultats procédant de mes calculs avec ceux de la BD (il doit s'agir d'une BD tirée d'un vieux bouquin de 1955 et non d'une formule) du lien en début de feuille. Choisis des concentrations à la mords-moi le nœud (style 12,83%). Pour l'intervalle [0 ; concentration choisie] dans "CALCULS POUR UN CHAMPION", choisis d'abord une concentration "Gamma1" qui soit proche et supérieure à 12,83% pour avoir un résultat plus exact. L'autre intevalle, il est fixé à [0 ; 100%]. Les résultats sont quand même surprenants.
N'utilisant que de faibles volumes dans mes préparations, pour les masses volumique, 3 décimales après la virgule sont très largement suffisantes. À moins d'être un psycho-rigide de la rigueur inutile muni d'une micropipette dont la précision aille jusqu'au 1/10.000ème de mL. Je ne sais même pas si elles existent...

En somme, voilà ce que l'on peut obtenir sur un fichier de 20 KB qui pourrait rentrer dans n'importe quelle calculatrice de poche (PJ).
Le 3ème problème étant le plus intéressant.

Il ne me reste plus qu'à résoudre cette équation du 3ème degré...

Bonne fin de soirée.

Magic_Doctor · 29 Décembre 2017

Je reviens au sujet d'une curiosité.

J'ai fait quelques modifications mineures dans ta macro, à savoir que toutes les cellules y apparaissant sont nommées. Je pense faire quelques modifications dans le tableau, ce qui m'évitera de reparamatrer toutes les macros.
Bref :
- $N$14 = [Tableau2].Columns(2).Rows(0)
- [T9] = [PourCentMV]

Le problème est : [M16:M47] 'colonne des pourcentages amputée du 0%

- [M16:M47] = [Tableau2].Columns(1).Offset(1, 0).Resize(HTABLO([Tableau2], 0) - 1, 1)

HTABLO est une fonction que tu avais concoctée, permettant de connaître la hauteur d'une plage de cellules encadrées, que celles-ci soient vides ou pas.

Là ça ne marche pas. J'ai été obligé de contourner le problème de la manière suivante :

Dim ad As String
Set r = [Tableau2].Columns(1).Offset(1, 0).Resize(HTABLO([Tableau2], 0) - 1, 1)
ad = r.Address
Set r = Evaluate(ad)

Et là ça marche.

VB:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Macros événementielles quand on double-clique sur certaines cellules
'---maximise la valeur cible T9---
'job75
  
    If Target <> [Tableau2].Columns(2).Rows(0) Then Exit Sub 'quand on ne double-clique pas sur l'en-tête de la colonne "N"
  
    Dim inf!, sup!, cible As Range, r As Range, imin&, mem, vmax, i&, ad As String
  
    Cancel = True
    inf = 1.45: sup = 2.35 'adaptables
    Set cible = [PourCentMV] 'la cellule qui affiche le pourcentage des masses volumiques obtenues par formule identiques à celles du labo (adaptable)
    'Set r = [M16:M47] 'adaptable
    Set r = [Tableau2].Columns(1).Offset(1, 0).Resize(HTABLO([Tableau2], 0) - 1, 1) 'colonne des % dont 0% est exclu (adaptable) ---> ne marche pas
    ad = r.Address
    Set r = Evaluate(ad)
    r(0, 2) = Application.Round(inf, 2) 'N15
    imin = inf * 100
    'mem = [Gamma1] 'mémorise la valeur de O9
    For Each r In r
        [Gamma1] = r 'modification de O9
        vmax = 0
        Application.ScreenUpdating = False
        For i = imin To sup * 100
            r(1, 2) = Application.Round(i / 100, 2) 'modification en colonne N
            If IsNumeric(cible) Then If cible > vmax Then vmax = cible: imin = i
        Next i
        r(1, 2) = Application.Round(imin / 100, 2) 'valeur retenue en colonne N
    Next r
    '[Gamma1] = mem
End Sub

Bizarre tout ça...

job75 · 30 Décembre 2017

Bonjour Magic_Doctor, le forum,

Avec les noms définis fais des choses simples, comme ceci par exemple :

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'---maximise la cible T9---
With [Tableau2]
  If Target.Address <> .Cells(0, 2).Address Then Exit Sub 'N14
  Dim inf#, sup#, cible As Range, jmin&, mem, i&, vmax, j&
  Cancel = True
  inf = 1.45: sup = 2.35 'adaptables
  Set cible = [PourCentMV] 'T9
  .Cells(1, 2) = inf 'N15
  jmin = inf * 100
  mem = [Gamma1] 'mémorise la valeur de O9
  Application.EnableEvents = False
  For i = 2 To .Rows.Count
    [Gamma1] = .Cells(i, 1) 'modification de O9
    vmax = 0
    Application.ScreenUpdating = False
    For j = jmin To sup * 100
      .Cells(i, 2) = j / 100 'modification en colonne N
      If IsNumeric(cible) Then If cible > vmax Then vmax = cible: jmin = j
    Next j
    .Cells(i, 2) = jmin / 100 'valeur retenue en colonne N
  Next i
  [Gamma1] = mem
  Application.EnableEvents = True
End With
End Sub

J'ai aussi ajouté les Application.EnableEvents ce qui réduit la durée d'exécution à 5 secondes.

Fichier (2).

A+

job75 · 30 Décembre 2017

Re,

En passant en calcul manuel la durée d'exécution passe à 0,6 seconde chez moi.

Seules sont recalculées les cellules O10, N48, la plage nécessaire en colonne O et bien sûr la cible T9 :

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'---maximise la cible T9---
With [Tableau2]
  If Target.Address <> .Cells(0, 2).Address Then Exit Sub 'N14
  Dim inf#, sup#, cible As Range, jmin&, mem, rc&, i&, vmax, j&
  Cancel = True
  inf = 1.45: sup = 2.35 'adaptables
  Set cible = [PourCentMV] 'T9
  jmin = inf * 100
  mem = [Gamma1] 'mémorise la valeur de O9
  rc = .Rows.Count
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual 'calcul manuel
  .Cells(1, 2) = inf 'N15
  For i = 2 To rc
    [Gamma1] = .Cells(i, 1) 'modification de O9
    [Gamma1].Offset(1).Calculate 'recalcule O10
    vmax = 0
    For j = jmin To sup * 100
      .Cells(i, 2) = j / 100 'modification en colonne N
      .Cells(rc + 1, 2).Calculate 'recalcule N48
      .Cells(1, 3).Resize(i).Calculate 'recalcule seulement la plage nécessaire en colonne O
      cible.Calculate 'recalcule cible
      If IsNumeric(cible) Then If cible > vmax Then vmax = cible: jmin = j
    Next j
    .Cells(i, 2) = jmin / 100 'valeur retenue en colonne N
  Next i
  [Gamma1] = mem
  Application.Calculation = xlCalculationAutomatic 'calcul automatique
  Application.EnableEvents = True
End With
End Sub

Nota : ne neutralise pas l'utilisation de la variable mem, les couleurs ne seraient pas correctes...

Fichier (3).

A+

job75 · 31 Décembre 2017

Bonjour Magic_Doctor, le forum,

Tu remarqueras que l'effacement de la cellule O9 entraîne un bug.

Pour l'éviter il suffit d'ajouter On Error Resume Next dans la fonction CompareCol.

J'en profite pour te féliciter de ton entrée dans le club des Barbatrucs et pour te souhaiter une très bonne année 2018.

Et en attendant, une bonne Saint-Sylvestre.

job75 · 31 Décembre 2017

Re Magic_Doctor,

¡Un regalito para finales de año!

Mejor escribir :

Code:

SOMMEPROD(N(TRONQUE(XXX;S8)=TRONQUE(YYY;S8))
SUMAPRODUCTO(N(TRUNCAR(XXX;S8)=TRUNCAR(YYY;S8))

en vez de :

Code:

SOMMEPROD(N(TRONQUE(XXX*10^S8)=TRONQUE(YYY*10^S8))
SUMAPRODUCTO(N(TRUNCAR(XXX*10^S8)=TRUNCAR(YYY*10^S8))

Buena fiesta de nochevieja.

A+

Magic_Doctor · 1 Janvier 2018

Bonsoir job,

Pas pu te lire avant por culpa de las fiestas.

D'abord, encore une fois, bravo job pour tes dernières modifications au sujet de l'automatisation du calcul par tâtonnement. Maintenant on vole ! Et dire que j'avais mis une bonne plombe pour dresser cette colonne N par tâtonnement...
Concernant la cellule O9, je n'avais jamais tenté d'effacer son contenu, puisque dès le départ j'avais décidé d'imposer le choix de la concentration par l'intermédiaire d'une liste déroulante. En effet, on doit OBLIGATOIREMENT choisir une concentration présente dans la colonne des abscisses (colonne M), sinon c'est la cata (impossible pour les formules et autres macros de trouver dans la colonne des abscisses un item qui n'existe pas). Je viens juste d'essayer et c'est la cata !
Donc, pas de fantaisies avec les concentrations. C'est la cellule qui, au final, on doit "super-protéger".
Quoi qu'il en soit, je viens de rectifier la fonction CompareCol. On efface O9 et absolument rien d'alarmant se passe ; il suffit de saisir une valeur dans la liste et c'est reparti !
Gracias por la cereza findeañera.

Muy feliz año nuevo para vos y todos tu seres queridos.

¡Y sigue la Revolución intelectual! ... Ça maintient les neurones en forme.

Automatiser un calcul par tâtonnement

Magic_Doctor

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

Magic_Doctor

XLDnaute Barbatruc

Pièces jointes

Magic_Doctor

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Magic_Doctor

XLDnaute Barbatruc

Automatiser un calcul par tâtonnement

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Privacy & Transparency

Privacy & Transparency