min max d'une fonction selon vba/excel

Version imprimable

Bonjour,
je suis vraiment mal prise, je ne sais pas si ce sujet a été déjà expliqué par le passé (j,ai chercher mais n'ai pas trouver ce qui pouvait m'aider vraiment) mais j'ai vraiment mais vraiment besoin d'aide.
Alors voilà, je dois élaborer un sub sur vba qui servira à trouver le x et le y qui vont minimiser ou maximiser une fonction entrée sur excel. le x et le y ne devront pas sortir des bornes inférieures et supérieures que l,on aura également entrées sur excel.

voici la page d,excel :

Nombre de pas 100
Fct x^2 * y^2

Bornes inférieures supérieures
x 0 5
y 0 6

X 4,9999999999999900
y 5,9999999999999900
f(x;y) 0,0000000000000000

(ici il y a un commandButton qui lorsqu'on le clique il exécute la macro qui sert à trouver les solutions)

sauts_x 0,05
sauts_y 0,06
recherche:choisir Minimum ou selon un combobox
Resultat 0
xOptimal 4,9999999999999900
yOptimal 5,9999999999999900

voici le code vba que j,ai élaboré jusqu,à maintenant
Code:

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 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 Sub trouve_min_ou_max() Dim recherche As String, fct As String, fct2 As String, fct1 As String Dim resultat As Double, xOptimal As Double, yOptimal As Double Min_X = Cells(5, 2) Max_X = Cells(5, 3) Min_Y = Cells(6, 2) Max_Y = Cells(6, 3) Pas = Cells(1, 2) sauts_X = Cells(12, 2) sauts_Y = Cells(13, 2) recherche = Cells(14, 2) fct = Cells(2, 2) For y = Min_Y To Max_Y Step sauts_Y Cells(9, 2) = y fct1 = Replace(fct, "y", y) For X = Min_X To Max_X Step sauts_X Cells(8, 2) = X fct2 = Replace(fct1, "x", X) Sheets("fonction").Cells(10, 2).Value = fct2 If y = Min_Y And X = Min_X Then fct2 = Cells(10, 2) Sheets("fonction").Cells(15, 2).Value = resultat Sheets("fonction").Cells(8, 2).Value = Min_X Sheets("fonction").Cells(9, 2).Value = Min_Y End If If recherche = "Maximum" Then If resultat > Cells(10, 2) Then Cells(10, 2) = resultat xOptimal = X yOptimal = y Sheets("fonction").Cells(15, 2).Value = resultat Sheets("fonction").Cells(16, 2).Value = xOptimal Sheets("fonction").Cells(17, 2).Value = yOptimal End If End If If recherche = "Minimum" Then If resultat < Cells(9, 2) Then ' Cells(10, 2) = resultat xOptimal = X yOptimal = y Sheets("fonction").Cells(15, 2).Value = resultat Sheets("fonction").Cells(16, 2).Value = xOptimal Sheets("fonction").Cells(17, 2).Value = yOptimal End If End If Next X Next y End Sub
je sais que je dois avoir beaucoup d'erreur là dedans mais je suis débutante en programmation.Cela me donne toujours les mêmes valeurs pour x et y qu'importe si je cherche le maximum ou le minimum, ce qui ne fait pas beaucoup de sens.Je vous remecie d'avance pour votre aide car j'en ai vraiment besoin.

lola

bonjour,
J'ai un peu de mal a comprendre ton algorithme (ca manque un peu de commentaire ;))

Si j'ai bien compris tu veux trouver un couple minimum pour cela tu utilise un algorithme que je qualifierais de bourrin et non une méthode mathématique un peu complexe. J'aime bien la première méthode la deuxième a l'avantage de plus triturer le cerveau :mouarf:

Je te laisse initialiser les variable avec tes valeurs
Chez moi ca semble tourner pas trop mal mais un peu lentement

Code:

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
Sub Macro8()
Dim NombreDePas As Integer, x As Double, y As Double
Dim preums As Boolean, MAXres As Double, MAXx As Double, MAXy As Double
Dim xmax As Double, xmin As Double, ymax As Double, ymin As Double
Dim fct As String
Dim fct1 As String
Dim i As Integer, j As Integer
 
fct = "x^2 * y^2"
xmax = 1 'borne max x
xmin = -1 'borne min x
ymax = 1 'borne max y
ymin = -1 'borne min x
NombreDePas = 100 'nombre de pas 
preums = True 'ne touche pas ;)
For i = 0 To NombreDePas 'on ne peux avoir que des entier
    x = xmin + (xmax - xmin) / NombreDePas * i 'on calcul x au ième pas
    For j = 0 To NombreDePas
        y = ymin + (ymax - ymin) / NombreDePas * j 'on calcul y au ième pas
        fct1 = Replace(fct, "x", x)
        fct1 = Replace(fct1, "y", y)
        Cells(1, 1).Formula = "=" & fct1  'met le resulatat dans une cellule temporaire
        If Cells(1, 1) > MAXres Or preums Then
            preums = False
            MAXres = Cells(1, 1)
            MAXx = x
            MAXy = y
 
 
        End If
    Next j
Next i
 
cells(1,1).clearcontents     'vide la cellule temporaire
 MsgBox "Le maximum de la fonction " & fct & " vaut " & MAXres & Chr(13) & "Il est atteint pour le couple (" & MAXx & ";" & MAXy & ")."
 
End Sub

Voila j'espère que ca t'aidera, mais tu le temps de calcul je te conseille un bon bouquin de math (analyse numérique) pour trouver une méthode un peu plus rapide, il devrait en exister plusieurs ;)

31/07/2009, 09h58
lola19

merci Krovax de prendre le temps de me répondre, tu ne peux pas savoir à quel point ça m'a aidé, j'étais desperée!!!

j'aurais seulement quelques questions:

1)quand j'essaye d'execute la macro, ça bloque là

Code:

Cells(1, 1).Formula = "=" & fct1 'met le resulatat dans une cellule temporaire

j'ai bien écrit les cellules appropriée mais je ne sais pas ce qui ne marche pas, ça dit ''application-defined error'' ce qui veut dire que la formule est mal définnie

2)si je veux trouver le couple de x et y qui vont minimiser ma fct, est ce que je ne fait que recopier la même démarche que pour le couple qui maximise mais en remplaçant max par min?

3) comme la definition de mes sauts =
sauts_x=(max_x-min_x) /nbpas et
saut_y = (max_y-min_y)/nbpas,
mes sauts ne sonts pas toujours des entiers , dépendant de mes bornes et du nombre de pas (qui peuvent varier selon ce qu'on inscrit dans les cellules)
alors, est ceque cela est pris en compte dans le code que tu as écrit parce qu'on dirait que les sauts dans la boucles ne sont que des entiers (est ce que ça change ma réponse si je fais des sauts entiers ou non)

encore merci!!!

(je suis désolée si c'est dur de comprendre tout ce que j'écris mais je ne suis pas complètement fluente en français:)
31/07/2009, 10h07
Krovax

Pour ton problème
avant la ligne écrit

Code:

msgbox "=" & fct1

et regarde ci cela correspond bien a la syntaxe d'une formule excel

Pour ton souci de pas (ce que tu appelles saut) je ne vois pas ou est ton problème
J'ai un certain nombre de pas NombreDePas
Je discrétise l'intervalle en calculant un pas
(xmax - xmin) / NombreDePas
je m'ultipli par le numéro de mon pas (i ou j) et ajoute le minimum ce qui me donne la valeur en cour,
pas la peine de se prendre d'avantage la tête en passant par un variable supplémentaire, non?
Ca fonctionne si tu veux t'en convaincre avance en pas a pas et regarde les valeur de x et y.

Si ca ne fonctionne pas montre nous le code que tu teste et met en commentaire le contenue des cellule que tu récupères
31/07/2009, 10h48
ouskel'n'or

Bonjour lola, les lola sont toujours les bienvenues sur le forum, :aie:
Hello Krovax, désolé de venir déranger votre intimité...
Pourquoi utilises-tu une cellule pour placer un résultat temporaire (ce qui ralentit la procédure) plutôt qu'une variable ? (je n'ai pas vu que Cells(1,1) était utilisé dans une formule)
Mais je n'ai pas approfondi plus que ça ;)

parce que je ne me souvient plus de la commande pour directement évaluer une fonction :oops:

Mais c'est bon je l'ai retrouvé

Code:

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
Sub Macro8()
Dim NombreDePas As Integer, x As Double, y As Double
Dim preums As Boolean, MAXres As Double, MAXx As Double, MAXy As Double
Dim xmax As Double, xmin As Double, ymax As Double, ymin As Double
Dim fct As String
dim res as double
Dim fct1 As String
Dim i As Integer, j As Integer
 
fct = "x^2 * y^2"
xmax = 1 'borne max x
xmin = -1 'borne min x
ymax = 1 'borne max y
ymin = -1 'borne min x
NombreDePas = 100 'nombre de pas 
preums = True 'ne touche pas ;)
For i = 0 To NombreDePas 'on ne peux avoir que des entier
    x = xmin + (xmax - xmin) / NombreDePas * i 'on calcul x au ième pas
    For j = 0 To NombreDePas
        y = ymin + (ymax - ymin) / NombreDePas * j 'on calcul y au ième pas
        fct1 = Replace(fct, "x", x)
        fct1 = Replace(fct1, "y", y)
        res=evaluate(fct1) 
        If res > MAXres Or preums Then
            preums = False
            MAXres = res
            MAXx = x
            MAXy = y
 
 
        End If
    Next j
Next i
 
cells(1,1).clearcontents     'vide la cellule temporaire
 MsgBox "Le maximum de la fonction " & fct & " vaut " & MAXres & Chr(13) & "Il est atteint pour le couple (" & MAXx & ";" & MAXy & ")."
 
End Sub

Normalement c'est bon mais là je ne pas peu pas trop tester trop de calcul en cours donc si quelqu'un pouvais confirmer :oops:

salut et merci beaucoup à vous deux de commenter:D

J'ai essayé le programme et il est bien meilleur que le mien sauf que quand je l'execute ça bogue.
Dans l'exercice, toute les variants entrés dans vba doivent reférer à des cells sur excel, donc je peux modifier sur excel la fonction (une selon x et y), les bornes, les sauts et donc les modifications vont se faire automatiquement sur vba. l'énoncé dit aussi qu'il doit y avoir un comboBox (à la cells(14,2))avec comme choix Maximum ou Minimum donc voici les petits changements que j,ai faites à partie de ça (surtout à la fin):

Code:

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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Sub Macro8()
Dim NombreDePas As Integer, x As Double, y As Double
Dim preums As Boolean, MAXres As Double, MAXx As Double, MAXy As Double
Dim MINres As Double, MINx As Double, MINy As Double
Dim xmax As Double, xmin As Double, ymax As Double, ymin As Double
Dim fct As String
Dim fct1 As String
Dim i As Integer, j As Integer
 
fct = Cells(2, 2)
xmax = Cells(5, 3) 'borne max x
xmin = Cells(5, 2) 'borne min x
ymax = Cells(6, 3) 'borne max y
ymin = Cells(6, 2) 'borne min x
NombreDePas = Cells(1, 2) 'nombre de pas
recherche = Cells(14, 2)
preums = True
For i = 0 To NombreDePas 'on ne peux avoir que des entier
    x = xmin + (xmax - xmin) / NombreDePas * i 'on calcul x au ième pas
    Cells(8, 2) = x
    For j = 0 To NombreDePas
        y = ymin + (ymax - ymin) / NombreDePas * j 'on calcul y au ième pas
        Cells(9, 2) = y
        fct1 = Replace(fct, "x", x)
        fct1 = Replace(fct1, "y", y)
        res = Evaluate(fct1)
        Cells(10, 2) = res
 
 
If recherche = "Maximum" Then ' si je choisis dans la comboBox à la cells(14,2) l'option Maximum
        If res > MAXres Or preums Then
            preums = False
            MAXres = res
            MAXx = x
            MAXy = y
        End If
 
End If
If recherche = "Minimum" Then ' si je choisis dans la comboBox à la cells(14,2) l'option Minimum
        If res < MINres Or preums Then
            preums = True
            MINres = res
            MINx = x
            MINy = y
        End If
 
 
    End If
 
    Next j
Next i
 
 
If recherche = "Maximum" Then
MsgBox "Le maximum de la fonction " & fct & " vaut " & MAXres & Chr(13) & "Il est atteint pour le couple (" & x & ";" & y & ")."
End If
 If recherche = "Minimum" Then
 MsgBox "Le minimum de la fonction " & fct & " vaut " & MINres & Chr(13) & "Il est atteint pour le couple (" & x & ";" & y & ")."
End If
End Sub

Sauf que quand j'execute, ça bogue là:

Code:

If res > MAXres Or preums Then

et ça dit ''type mismatch'', j'ai essayé de changé le signe mais ça me dit la même chose

encore merci

lola:)

31/07/2009, 14h17
ouskel'n'or

Oui, je pense que ça vient de deux comparaisons de natures différentes :
je suppose que res > MAXres sont des valeurs
alors que preums ressemble à un boolean...
Teste ça

Code:

If (res > MAXres) Or preums Then

(pas le temps de me plonger ds le code, j'ai mes bagages à préparer ;))
31/07/2009, 14h17
Krovax

Tu n'as pas déclarer la variable res

Code:

dim res as double

tu es en option explicite?
31/07/2009, 14h21
ouskel'n'or

Citation:

et ça dit ''type mismatch''

Bonjour Lola19, le forum,

décidément les lolas ont du succès :D, la prochaine fois que je voudrai une réponse sur le forum je posterai sous le pseudo "Jessica69". :mouarf3:

Blagues dans le coin, je mets en pièce jointe un fichier Excel qui permet je crois de répondre à ta question. (Je m'étais posé une question semblable il y a quelque temps...)
La macro teste toutes les combinaisons de valeurs X et Y rentrées dans l'onglet "hyp". Elle compare tous les résultats f(X,Y) de la fonction et retiens le couple min ou max en fonction de ce que tu demandes dans le code.
Bien entendu tu peux changer de fonction et tu peux tester beaucoup plus de valeurs. Tu seras simplement limitée par le temps et la puissance de ton processeur.

le code de la macro :
Code:

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 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 Sub testhyp() Dim i As Long Dim j As Long Dim k As Integer Dim n As Integer Dim p As Integer Dim vari() As Double Dim fl As Integer Dim val As Integer Dim nbrligneparonglet As Long Dim t_deb As Single, t_fin As Single, tpass As Single Dim resultatminimum As Double k = Sheets("hyp").Range("b65536").End(xlUp).Row - 1 n = Sheets("hyp").Range("IV2").End(xlToLeft).Column - 1 Rows("6:6").ClearContents Rows("16:16").ClearContents For p = 1 To n Sheets("Resultat").Cells(6, 1 + p).Value = Sheets("Hyp").Cells(2, 1 + p).Value Next Sheets(3).Select t_deb = Timer ReDim vari(1 To n, 1 To k) For i = 1 To n For j = 1 To k vari(i, j) = Sheets("hyp").Cells(j + 1, i + 1) Next j Next i 'resultatminimum = CDbl(Sheets(1).Cells(10, 3).Text) resultatminimum = 10000000000# For i = 0 To k ^ n - 1 For j = 0 To n - 1 val = (i \ (k ^ j)) Mod (k) Sheets(1).Cells(6, 2 + j).Value = vari(j + 1, val + 1) Next j If CDbl(Sheets(1).Cells(10, 3).Text) < resultatminimum Then For j = 0 To n - 1 Sheets(1).Cells(16, 2 + j).Value = Sheets(1).Cells(6, 2 + j).Value Next j resultatminimum = CDbl(Sheets(1).Cells(10, 3).Text) Else 'indique ici ce que tu veux faire en cas d'égalité par exemple End If Next i t_fin = Timer tpass = CSng(Round(t_fin - t_deb, 2)) Sheets("Resultat").Select MsgBox "Calcul terminé! Il a fallu " & tpass & " s pour tester les " & n ^ k & " " & n & "-uplets" End Sub
J'espère que ça répond à tes attentes.

A+

31/07/2009, 20h22
lola19

oh je me sens toute special :zoubi: ...:lol:
Je vous remercie pour toutes vos réponses, elles m'ont été d'un grand aide,merci!!!
j,ai fini par faire fonctionner mon programme après des heures et des heures de tatonnage, je ne sais pas s'il est parfait mais il a l'air de donner des réponses qui ont du sens, ce qui est sur, c'est que je n'aurais pas pu le faire sans votre aide à vous tous ;)

encore merci!!!!!!!!

à la prochaine

lola