min max d'une fonction selon vba/excel

**lola19** · 31/07/2009, 01h00

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Krovax** · 31/07/2009, 09h05

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

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**lola19** · 31/07/2009, 09h58

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

 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

**Krovax** · 31/07/2009, 10h07

Pour ton problème
avant la ligne écrit

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**ouskel'n'or** · 31/07/2009, 10h48

Bonjour lola, les lola sont toujours les bienvenues sur le forum,

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

**Krovax** · 31/07/2009, 11h14

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

Mais c'est bon je l'ai retrouvé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**lola19** · 31/07/2009, 13h00

salut et merci beaucoup à vous deux de commenter

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

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

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

If (res > MAXres) Or preums Then

(pas le temps de me plonger ds le code, j'ai mes bagages à préparer

)

**Krovax** · 31/07/2009, 14h17

Tu n'as pas déclarer la variable res

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

dim res as double

tu es en option explicite?

**ouskel'n'or** · 31/07/2009, 14h21

et ça dit ''type mismatch''

**kokoVBA** · 31/07/2009, 14h47

Bonjour Lola19, le forum,

décidément les lolas ont du succès

, la prochaine fois que je voudrai une réponse sur le forum je posterai sous le pseudo "Jessica69".

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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+

**lola19** · 31/07/2009, 20h22

oh je me sens toute special

...

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

min max d'une fonction selon vba/excel

Macros et VBA Excel

Discussions similaires

Partager

Partager