Discussion :

[lola19]

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]

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]

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]

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]

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]

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