Discussion :

[JonSnow]

Bonjour à tous,

pour mon boulot, je dois faire un graphique, récupérer les paramètres de la droite de régression linéaire et optimiser une variable pour que le coefficient directeur soit 1.

La procédure havodcalc permet de calculer les données nécessaire pour tracer la courbe.

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
Public Sub havodcalc()
Dim cell As Range
Dim dP As Double
Dim plageP As Range
 
Pi = ThisWorkbook.Worksheets(1).Range("B5").Value
Boi = ThisWorkbook.Worksheets(1).Range("K5").Value
Rsi = ThisWorkbook.Worksheets(1).Range("I5").Value
Bgi = ThisWorkbook.Worksheets(1).Range("H5").Value
Swi = ThisWorkbook.Worksheets(1).Range("G2").Value
m = ThisWorkbook.Worksheets(1).Range("G1").Value
cf = ThisWorkbook.Worksheets(2).Range("B4").Value
xR = ThisWorkbook.Worksheets(1).Range("H1").Value
xL = ThisWorkbook.Worksheets(1).Range("H2").Value
Weig = ThisWorkbook.Worksheets(1).Range("J1").Value
 
For Each cell In ThisWorkbook.Worksheets(1).Range("B6", Range("B6").End(xlDown))
 
P = cell.Value
dP = Pi - P
 
Np = cell.Offset(0, 2)
Rp = cell.Offset(0, 3) / Np
Wp = cell.Offset(0, 4)
Bg = cell.Offset(0, 6)
Rs = cell.Offset(0, 7)
Bo = cell.Offset(0, 9)
Bw = cell.Offset(0, 10)
cw = cell.Offset(0, 11)
 
If ThisWorkbook.Worksheets(1).CheckBox1.Value = False Then Eg = 0 Else: Eg = Boi * (Bg / Bgi - 1)
If ThisWorkbook.Worksheets(1).CheckBox1.Value = False Then m = 0 Else m = ThisWorkbook.Worksheets(1).Range("G1").Value
 
If ThisWorkbook.Worksheets(1).CheckBox2.Value = True Then Efw = 0 Else: Efw = (1 + m) * Boi * ((cw * Swi + cf) / (1 - Swi)) * dP
 
Eo = (Bo - Boi) + (Rsi - Rs) * Bg
 
F = Np * (Bo + (Rp - Rs) * Bg) + Wp * Bw
Et = Eo + m * Eg + Efw
 
cell.Offset(0, 13) = F
cell.Offset(0, 14) = Eo
cell.Offset(0, 15) = Eg
cell.Offset(0, 16) = Efw
cell.Offset(0, 17) = Weig / Et
cell.Offset(0, 18) = F / Et
cell.Offset(0, 19) = Et
Next cell
 
End Sub

Graphique s'occupe de tracer la courbe et de récuperer les coefficients de regression.

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
Public Sub graphique()
Dim graph As Chart, feuille1 As Worksheet, plageX As Range, plageY As Range
Dim cell As Range
Dim dP As Double
 
'Suppression du graphique existant
Application.DisplayAlerts = False
    While Charts.Count > 0
        Charts(1).Delete
    Wend
 
'Creation d'un nouveau graphique
Set feuille1 = ThisWorkbook.Worksheets(1)
Set feuille2 = ThisWorkbook.Worksheets(2)
With feuille1
Set plageX = .Range("S6", Range("S6").End(xlDown))
Set plageY = .Range("T6", Range("T6").End(xlDown))
End With
Set graph = ThisWorkbook.Charts.Add
Set graph = ThisWorkbook.Charts(1)
graph.ChartArea.Clear
graph.ChartType = xlXYScatter
 
Set maserie = graph.SeriesCollection.NewSeries
With maserie
.Values = plageY
.XValues = plageX
End With
'Ajout d'une courbe de tendance
graph.SeriesCollection(1).Trendlines.Add
graph.SeriesCollection(1).Trendlines(1).Type = xlLinear
graph.SeriesCollection(1).Trendlines(1).DisplayEquation = True
graph.SeriesCollection(1).Trendlines(1).DisplayRSquared = True
 
'Calcul des paramètres de la regression linéaire
P = Application.WorksheetFunction.Slope(plageY, plageX)
inter = Application.WorksheetFunction.Intercept(plageY, plageX)
ThisWorkbook.Worksheets(1).Range("W1") = P
ThisWorkbook.Worksheets(1).Range("W2") = inter
 
End Sub

La procédure Opt sert à optimiser le paramètre Weig par dichotomie et fait appel aux procédures havodcalc et graphique.

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
Sub Opt()
 
Dim graph As Chart, feuille1 As Worksheet, plageX As Range, plageY As Range
Dim cell As Range
Dim dP As Double
 
Set feuille1 = ThisWorkbook.Worksheets(1)
 
P = ThisWorkbook.Worksheets(1).Range("W1")
 
'optimisation de Weig
Epsi = 2
xR = ThisWorkbook.Worksheets(1).Range("H1").Value
xL = ThisWorkbook.Worksheets(1).Range("H2").Value
Do While (xR - xL) > Epsi Or P <> 1
Weig = (xR - xL) / 2
ThisWorkbook.Worksheets(1).Range("J1").Value = Weig
 
If P < 1 Then
xL = Weig
Else
xR = Weig
End If
Call havodcalc
Call graphique
Loop
End Sub

Si j'utilise les 2 premières procédures, la courbe s'affiche mais quand j'essqie d'optimiser, j'ai une erreur 1004: Erreur définie par l'emploi ou définie par l'objet sur la ligne

Code :

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

For Each cell In ThisWorkbook.Worksheets(1).Range("B6", Range("B6").End

Quelqu'un aurait il une idée soit pour contourner le problème, soit pour corriger l'erreur ?

Merci d'avance.

Jon

Ps: pas sur que le test de l'erreur soit bon, je bosse sur une version en allemand d'Excel...

Ps2: je pourrais héberger le fichier au besoin.

[Didier Gonard]

Bonjour,


Dans opt, à quoi te sert cette ligne ?

Code :

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

Set feuille1 = ThisWorkbook.Worksheets(1)

Ps : supprimé précédent message car ta citation de ligne est incomplète, mais ligne OK dans le code sinon

cordialement,

Didier

[Gorfael]

Salut JonSnow et le forum
Du mal à comprendre le problème : quelle est la ligne en erreur ?
Tu mets

Code :

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

1
2
3
4
5
If P < 1 Then
xL = Weig
Else
xR = Weig
End If

dans ta formule Opt, mais tu les redéfinis dans

Code :

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

1
2
3
4
5
6
Public Sub havodcalc()
.......
xR = ThisWorkbook.Worksheets(1).Range("H1").Value
xL = ThisWorkbook.Worksheets(1).Range("H2").Value
Weig = ThisWorkbook.Worksheets(1).Range("J1").Value
.......

Ensuite, tu déclares certaines variables (Cell, dp et plagep ) qu'à priori tu n'utilises pas forcément, alors que tu ne déclares pascelles que tu utilises...
Juste une idée : tu ne transmets pas des varaibles que tu penses avoir initialisées. Mais ça veut dire que tu ne donnes pas le code que tu utilises avec la macro Opt.
A+

[JonSnow]

Merci de vos réponses. Je ne m'attendait pas à en avoir si rapidement. Excusez moi pour la mise en forme un peu sauvage mais j'utilise VBA depuis peu. J'ai encore du mal avec certaines notions. C'est un peu pour ca que je ne déclare pas toute mes variables.

J'ai fait un peu de ménage dans le code (la variable P était d'ailleurs utilisées 2 fois pour 2 choses différentes..) et cela devrait être un peu plus clair.

Je vais tenter de donner plus d'explications. Ces 3 procédures ne sont qu'une partie de mon code. Dans les étapes précédentes, j'ai rempli les cases de ma feuille Excel en calculant des correlations basées sur la variable P (la colonne B). Je veux maintenant utiliser ces correlations pour déterminer Weig et la méthode mathématique la plus simple (mise en place dans la procédure havodcalc) est de tracer F/Et en fonction Weig/Et.
Quand Weig est bon, la droite doit avoir un coefficient directeur de 1.
Donc je fais au départ une estimation de Weig et la procédure Opt devrait me permettre de trouver la bonne valeur.

Si je lance havodcalc seule avec la procédure graphique (voir précédent post), les calculs de F/Et et de We/Et sont bien effectués.

Par contre, quand j'ajoute la procédure Opt, l'erreur 1004 se produit au niveau de la ligne en Rouge gras dans le code suivant et rien n'est calculé.

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
Public Sub havodcalc()
Dim cell As Range
Dim dP As Double
Dim P As Variant

Pi = ThisWorkbook.Worksheets(1).Range("B5").Value
Boi = ThisWorkbook.Worksheets(1).Range("K5").Value
Rsi = ThisWorkbook.Worksheets(1).Range("I5").Value
Bgi = ThisWorkbook.Worksheets(1).Range("H5").Value
Swi = ThisWorkbook.Worksheets(1).Range("G2").Value
m = ThisWorkbook.Worksheets(1).Range("G1").Value
cf = ThisWorkbook.Worksheets(2).Range("B4").Value
xR = ThisWorkbook.Worksheets(1).Range("H1").Value
xL = ThisWorkbook.Worksheets(1).Range("H2").Value
Weig = ThisWorkbook.Worksheets(1).Range("J1").Value

For Each cell In ThisWorkbook.Worksheets(1).Range("B6", Range("B6").End(xlDown))
P = cell.Value
dP = Pi - P
 
Np = cell.Offset(0, 2)
Rp = cell.Offset(0, 3) / Np
Wp = cell.Offset(0, 4)
Bg = cell.Offset(0, 6)
Rs = cell.Offset(0, 7)
Bo = cell.Offset(0, 9)
Bw = cell.Offset(0, 10)
cw = cell.Offset(0, 11)

If ThisWorkbook.Worksheets(1).CheckBox1.Value = False Then Eg = 0 Else: Eg = Boi * (Bg / Bgi - 1)
If ThisWorkbook.Worksheets(1).CheckBox1.Value = False Then m = 0 Else m = ThisWorkbook.Worksheets(1).Range("G1").Value

If ThisWorkbook.Worksheets(1).CheckBox2.Value = True Then Efw = 0 Else: Efw = (1 + m) * Boi * ((cw * Swi + cf) / (1 - Swi)) * dP

Eo = (Bo - Boi) + (Rsi - Rs) * Bg

F = Np * (Bo + (Rp - Rs) * Bg) + Wp * Bw
Et = Eo + m * Eg + Efw

Next cell
End Sub

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
Sub Opt()
 
Pente = ThisWorkbook.Worksheets(1).Range("W1")
 
'optimisation de Weig
Epsi = 2
Do While (xR - xL) > Epsi Or Pente <> 1
Weig = (xR - xL) / 2
ThisWorkbook.Worksheets(1).Range("J1").Value = Weig
 
If Pente < 1 Then
xL = Weig
Else
xR = Weig
End If
Call havodcalc
Call graphique
Loop
End Sub

Ce que je ne comprend pas, c'est pourquoi la mise en place de la procédure Opt fait tout planté...

J'espère que c'est plus clair comme ceci.

Jon

[JonSnow]

Bon, de retour de week end et toujours le même soucis. J'ai tenté de passer par un compteur, de réunir les 3 procèdures en 1 seule. Il semblerait qu'excel pense que la plage

Code :

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

ThisWorkbook.Worksheets(1).Range("B6", Range("B6").End(xlDown))

est vide. Mais ce n'est pas le cas vu qu'elle est utilisée plus tôt dans une autre procédure et qu'elle est pleine de données...

Quelqu'un saurait il d'où sa pourrait venir svp ?

[casefayere]

Bonjour,

essayes comme ça :

Code :

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

For Each cell In sheets("nomfeuil").Range("B6", Range("B" & sheets("nomfeuil").rows.count).End(xlup).row)

remplace nomfeuil par le nom de ta feuille

Bonne journée

[Didier Gonard]

bonjour,

si la dernière option proposée ne marche toujours pas, à ce stade, mets en pj ton classeur ou un classeur qui comprend les données suffisantes pour répliquer le problème, qu'on puisse voir ça

cordialement,

Didier

[JonSnow]

Bonjour,

la méthode proposée par casefayere ne marche pas non plus.

Comme demander, j'ai héberger mon classeur sur cjoint:
http://cjoint.com/?emkPjUDCxI

Toutes les infos nécessaires sont dedans et j'ai trafiqué les données pour des raisons évidentes de confidentialité. Si vous avez besoin d'explications supplémentaires, n'hésitez pas.

Merci beaucoup,

Jon

[casefayere]

rien que ce code ne peut fonctionner :

Code :

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

For Each cell In feuille1.Range("B5", Range("B5").End(xlDown))

car Range("B5").End(xlDown) est une valeur et non un numéro de ligne

Code :

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

For Each cell In feuille1.Range("B5", "b" & feuille1.Range("B5").End(xlDown).row)

voilà une meilleure syntaxe

toutes les autres boucles sont à contrôler

[JonSnow]

Hum, sa marche! Enfin la valeur final n'est pas encore bonne mais au moins les calculs sont effectués.

Merci infiniment à vous tous.

[Didier Gonard]

bonjour,

j'ai trafiqué les données pour des raisons évidentes de confidentialité

exactement ce qu'il faut faire

essaies ainsi dans opt :

Code :

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

1
2
3
'nouveau calcul par la methode havlena Odeh
Sheets("Mass balance chp").Select
For Each cell In Sheets("Mass balance chp").Range("B6", Range("B" & Sheets("Mass balance chp").Rows.Count).End(xlUp))

Sinon ton truc a l'air assez savant, mais comme tu le précises, tu débutes en vba, je t'encouragerai donc à consulter les tutoriels de DVP que tu ne devrais pas avoir de mal à comprendre genre :

Programmer efficacement avec Excel en VBA

Car si tu arrives à faire tourner ton appli, elle sera une véritable bombe à retardement codée ainsi rien qu'au niveau lisibilité

vois de toutes urgence notamment, "Application.ScreenUpdating " l'instruction With et l'emploi des variables objet (cf RAbilloud)...

Sinon attention aux appels récursifs et l'entrée en boucles infinies etc..

bon courage,

cordialement,

Rajout : pas rafraîchit, sinon, tu peux dire si simple ce que tu as changé pour en faire profiter les lecteurs futurs
Didier

[JonSnow]

Ce qui n' allait pas,c'était que j'avais essayé la methode de Casefeyre que sur la boucle problématique. Or elles avaient toutes le même problème et ils fallait remplacer la syntaxe dans chaque boucle.

Merci pour le lien, Ormonth. Je vais lire sa et adapter mon code afin qu'il soit nickel.

Encore merci. Je risque de revenir souvent.

Jon