VBA Gestion de Portefeuille, portefeuille optimal - VB/VBA/VBS - Programmation
MarshPosté le 18-04-2013 à 23:28:43
Bonjour,
J'ai un gros problème avec l'optimisation d'un portefeuille sous VBA. Une des contraintes de mon solveur est le fait que la somme des investissements soit égale à 1 ! , cette contrainte n'est respectée que dans le cas ou la Vente à Découvert est autorisée et pas dans le cas inverse.
Je vous joint le code ci dessous:
Sub proc()
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ' Mise en place du Solveur '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 'solverReset Dim i As Integer Dim wsReport As Worksheet Dim titres As Integer Set wsReport = ThisWorkbook.Worksheets(1) titres = (-wsReport.Cells(15, 2).Row + wsReport.Cells(15, 2).End(xlDown).Row + 1)
'Réinitialisation du solveur solverreset
'On suppose que la VAD est autorisée par défaut solveroptions assumenonneg:=False
'Paramétrage de la fonction objectif du solveur en modifiant les parts du PF SolverOk SetCell:=Range("eu" ), MaxMinVal:=1, ByChange:=Range("parts" )
'Contrainte égalisant l'invetissement total à 100% C'est cette contrainte qui pose problème solveradd cellref:=wsReport.Cells(10, 3), relation:=2, formulatext:="1.0000"
'Fixation des contraites des parts par rapport aux bornes Min et Max & intégration de la contrainte sur la VAD For i = 1 To titres
If wsReport.Cells(3, 3).Value = "True" Then If wsReport.Cells(14 + i, 4).Value <> "inf" Then solveradd cellref:=wsReport.Cells(14 + i, 3), relation:=3, formulatext:=wsReport.Cells(14 + i, 4) End If
Else If wsReport.Cells(14 + i, 4).Value <> "inf" Then solveradd cellref:=wsReport.Cells(14 + i, 3), relation:=3, formulatext:=wsReport.Cells(14 + i, 4) solveradd cellref:=wsReport.Cells(14 + i, 3), relation:=3, formulatext:="0" Else solveradd cellref:=wsReport.Cells(14 + i, 3), relation:=3, formulatext:="0" End If
If wsReport.Cells(14 + i, 5).Value <> "inf" Then solveradd cellref:=wsReport.Cells(14 + i, 3), relation:=1, formulatext:=wsReport.Cells(14 + i, 5) End If End If Next i
'Fixation des contraintes des parts géographiques en fonction des contraintes Min et Max For i = 1 To 4 If wsReport.Cells(11, 5 + i).Value <> "inf" Then solveradd cellref:=wsReport.Cells(10, 5 + i), relation:=3, formulatext:=wsReport.Cells(11, 5 + i) End If If wsReport.Cells(12, 5 + i).Value <> "inf" Then solveradd cellref:=wsReport.Cells(10, 5 + i), relation:=1, formulatext:=wsReport.Cells(12, 5 + i) End If Next i solveradd cellref:=wsReport.Cells(10, 3), relation:=2, formulatext:=wsReport.Cells(10, 4) SolverSolve
End Sub
--------------- Le temps est un grand professeur mais malheureusement il tue ses élèves.
Marsh Posté le 18-04-2013 à 23:28:43
Bonjour,
J'ai un gros problème avec l'optimisation d'un portefeuille sous VBA.
Une des contraintes de mon solveur est le fait que la somme des investissements soit égale à 1 ! , cette contrainte n'est respectée que dans le cas ou la Vente à Découvert est autorisée et pas dans le cas inverse.
Je vous joint le code ci dessous:
Sub proc()
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
' Mise en place du Solveur
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'solverReset
Dim i As Integer
Dim wsReport As Worksheet
Dim titres As Integer
Set wsReport = ThisWorkbook.Worksheets(1)
titres = (-wsReport.Cells(15, 2).Row + wsReport.Cells(15, 2).End(xlDown).Row + 1)
'Réinitialisation du solveur
solverreset
'On suppose que la VAD est autorisée par défaut
solveroptions assumenonneg:=False
'Paramétrage de la fonction objectif du solveur en modifiant les parts du PF
SolverOk SetCell:=Range("eu" ), MaxMinVal:=1, ByChange:=Range("parts" )
'Contrainte égalisant l'invetissement total à 100% C'est cette contrainte qui pose problème
solveradd cellref:=wsReport.Cells(10, 3), relation:=2, formulatext:="1.0000"
'Fixation des contraites des parts par rapport aux bornes Min et Max & intégration de la contrainte sur la VAD
For i = 1 To titres
If wsReport.Cells(3, 3).Value = "True" Then
If wsReport.Cells(14 + i, 4).Value <> "inf" Then
solveradd cellref:=wsReport.Cells(14 + i, 3), relation:=3, formulatext:=wsReport.Cells(14 + i, 4)
End If
Else
If wsReport.Cells(14 + i, 4).Value <> "inf" Then
solveradd cellref:=wsReport.Cells(14 + i, 3), relation:=3, formulatext:=wsReport.Cells(14 + i, 4)
solveradd cellref:=wsReport.Cells(14 + i, 3), relation:=3, formulatext:="0"
Else
solveradd cellref:=wsReport.Cells(14 + i, 3), relation:=3, formulatext:="0"
End If
If wsReport.Cells(14 + i, 5).Value <> "inf" Then
solveradd cellref:=wsReport.Cells(14 + i, 3), relation:=1, formulatext:=wsReport.Cells(14 + i, 5)
End If
End If
Next i
'Fixation des contraintes des parts géographiques en fonction des contraintes Min et Max
For i = 1 To 4
If wsReport.Cells(11, 5 + i).Value <> "inf" Then
solveradd cellref:=wsReport.Cells(10, 5 + i), relation:=3, formulatext:=wsReport.Cells(11, 5 + i)
End If
If wsReport.Cells(12, 5 + i).Value <> "inf" Then
solveradd cellref:=wsReport.Cells(10, 5 + i), relation:=1, formulatext:=wsReport.Cells(12, 5 + i)
End If
Next i
solveradd cellref:=wsReport.Cells(10, 3), relation:=2, formulatext:=wsReport.Cells(10, 4)
SolverSolve
End Sub
---------------
Le temps est un grand professeur mais malheureusement il tue ses élèves.