Fontion interolation cubique

[sylrehl]

Bonjour,

Nouveau venu dans ce type de discussion, je me permets de vous faire part de mon probleme.

J'ai écris le programme VBA suivant qui ne fonctionne pas.
Quequ'un pourrais éclairer ma lanterne sur la raison de ce non fonctionnement?

Merci par avance pour votre aide.

Syl

Voila le texte:
Function InterpolationCubique(TableauMaturites, TableauDonnees, DateCalculees, _
Optional EstFactActua As Boolean = False, Optional DateDeCalcul As Date)

'Cette fonction determine à partir d'un vecteur de dates et d'un vecteur de donnees, les donnees
'interpolees par un polynome de degre 3 pour les dates du vecteur DateCalcules.

Dim TabMat
'Tableau des maturites des donnees sources
Dim Tabdata
'Donnees sources
Dim TabDates
'Dates a calculer
Dim i As Integer, j As Integer
'Variables de boucle
Dim TabRetour
'Donnees renvoyees
Dim MatriceDate(4, 4)
'Matrice des coefficients des parametres
Dim MatDateInv As Variant
'Matrice inverse de MatriceDate
Dim VecTaux(4, 1)
'Vecteur des donnees solutions du systeme
Dim VecParam
'Vecteur des parametres calcules

'Conversion des arguments en tableaux
TabMat = CTableau(TableauMaturites)
Tabdata = CTableau(TableauDonnees)
TabDates = CTableau(DateCalculees)

'Dimensionnement du tableau de retour
ReDim TabRetour(LBound(TabDates) To UBound(TabDates))

For i = LBound(TabDates) To UBound(TabDates)
'Boucle sur les dates à calculer

If TabDates(i) <= TabMat(1) Then
'Test des bornes, cas de la borne inferieure
TabRetour(i) = InterpolationLineaire(TabMat, Tabdata, TabDates(i), EstFactActua, DateDeCalcul)(1)
ElseIf TabDates(i) >= TabMat(UBound(TabMat) - 1) Then
'Test des bornes, cas de la borne superieure
TabRetour(i) = InterpolationLineaire(TabMat, Tabdata, TabDates(i), EstFactActua, DateDeCalcul)(1)
ElseIf UBound(TabMat) < 4 Then
'Pas assez de donnees pour effectuer une interpolation cubique
TabRetour(i) = InterpolationLineaire(TabMat, Tabdata, TabDates(i), EstFactActua, DateDeCalcul)(1)
Else
For j = 3 To UBound(TabMat) - 2
'On recherche la 1ere date superieure à la date calculee
If TabMat(j) > TabDates(i) Then
Exit For
End If
Next

'On renseigne la matrice de date
MatriceDate(1, 1) = CDbl(TabMat(j - 2) ^ 3)
MatriceDate(1, 2) = TabMat(j - 2) ^ 2
MatriceDate(1, 3) = CDbl(TabMat(j - 2))
MatriceDate(1, 4) = 1
MatriceDate(2, 1) = CDbl(TabMat(j - 1) ^ 3)
MatriceDate(2, 2) = TabMat(j - 1) ^ 2
MatriceDate(2, 3) = CDbl(TabMat(j - 1))
MatriceDate(2, 4) = 1
MatriceDate(3, 1) = CDbl(TabMat(j) ^ 3)
MatriceDate(3, 2) = TabMat(j) ^ 2
MatriceDate(3, 3) = CDbl(TabMat(j))
MatriceDate(3, 4) = 1
MatriceDate(4, 1) = CDbl(TabMat(j + 1) ^ 3)
MatriceDate(4, 2) = TabMat(j + 1) ^ 2
MatriceDate(4, 3) = CDbl(TabMat(j + 1))
MatriceDate(4, 4) = 1


'On renseigne le vecteur de donnees
VecTaux(1, 1) = Tabdata(j - 2)
VecTaux(2, 1) = Tabdata(j - 1)
VecTaux(3, 1) = Tabdata(j)
VecTaux(4, 1) = Tabdata(j + 1)

'Inversion da la matrice de date
MatDateInv = Application.WorksheetFunction.MInverse(MatriceDate)

'Resolution du systeme
VecParam = Application.WorksheetFunction.MMult(MatDateInv, VecTaux)

'Calcul de la valeur interpolee
TabRetour(i) = VecParam(1, 1) * TabDates(i) ^ 3 + VecParam(2, 1) * TabDates(i) ^ 2 + _
VecParam(3, 1) * TabDates(i) + VecParam(4, 1)
End If
Next
InterpolationCubique = TabRetour
End Function

 

[Martius Calvo]

Re : Fontion interolation cubique

bonsoir,

Je planche actuellement sur la même fonction d'interpolation cubique , (issu de l'ouvrage de Stéphane Hamard, Maths Fi avec VBA Excel), et pour ma part j'ai un message d'erreur "#Valeur" . Etait ce votre cas SVP ?
Je ne comprend pas car la fonction en interpolation linéaire, elle fonctionne bien. En vous remerciant par avance de votre aide sur le sujet.
bien cordialement et bonnes fêtes de fin d'année
M. Calvo

 

[Martius Calvo]

Re : Fontion interpolation cubique

Bonsoir,

J'espère que vous avez pu depuis 2007 trouver une solution à ce pb sur ce programme d'interpolation cubique

Sinon voilà la solution que j'ai trouvé grâce à un internaute texan, que je remercie:


L'exemple du Livre omet 2 choses:

1. l'Instruction : Option Base 1 car sinon les Lbound démarrent à zéro

: cela fait échec à l'inversion de Matrice!

1. La matrice de calcul intermédiaire MatriceDate doit être définie comme As Double

Avec ces 2 corrections, le programme marche enfin !

J'espère que cela servira à quelques uns

Bonne soirée Bon week end !

 

[kiddus i]

Re : Fontion interpolation cubique

bonsoir,
je me retouve également confronté à ce problème, et ce malgré ton explication et celle de notre ami texan... il faut dire que je ne suis pas très bon en vba....
pourrais tu s'il te plaît être plus précis

je te fais suivre ce que j'ai écris suite à ta réponse :
merci de ton aide
cheers

Function InterpolationCubique(TableauMaturites, TableauDonnees, _
DateCalculees, _
Optional EstFactActua As Boolean = False, Optional _
DateDeCalcul As Date)

'=============================================================
'Cette fonction détermine à partir d'un vecteur de dates
'et d'un vecteur de données, les données interpolées
'par un polynome de degré 3 pour les dates du vecteur DatesCalculées
'=============================================================

Dim TabMat
'Tableau des maturités des données sources
Dim TabData
'Données sources
Dim TabDates
'Dates à calculer
Dim i As Integer, j As Integer
'Variables de boucle
Dim TabRetour
'Données renvoyées
Dim MatriceDate(4, 4) As Double
'Matrice des coefficients des paramètres
Dim MatDatInv As Variant
'Matrice inverse de MatriceDate
Dim VecTaux(4, 1)
'Vecteur des données solutions du système
Dim VecParam
'Vecteur des paramètres calculés



'Conversion des arguments en tableau
TabMat = CTableau(TableauMaturites)
TabData = CTableau(TableauDonnees)
TabDates = CTableau(DateCalculees)

'Dimensionnement des tableaux de retour
ReDim TabRetour(LBound(TabDates) To UBound(TabDates))


For i = LBound(TabDates) To UBound(TabDates)
'Boucle sur les dates à calculer

If TabDates(i) <= TabMat(2) Then
'Test des bornes, cas de la borne inférieure
TabRetour(i) = InterpolationLineaire(TabMat, TabData, _
TabDates(i), _
EstFactActua, DateDeCalcul)(1)
ElseIf TabDates(i) >= TabMat(UBound(TabMat) - 1) Then
'Test des bornes, cas de la borne supérieure
TabRetour(i) = InterpolationLineaire(TabMat, TabData, _
TabDates(i), _
EstFactActua, DateDeCalcul)(1)
ElseIf UBound(TabMat) < 4 Then
'Pas assez de données pour éffectuer une interpolation cubique
TabRetour(i) = InterpolationLineaire(TabMat, TabData, _
TabDates(i), _
EstFactActua, DateDeCalcul)(1)
Else
For j = 3 To UBound(TabMat) - 2
'On recherche la première date supérieure à
'la date calculée
If TabMat(j) > TabDates(i) Then
Exit For
End If
Next

'On renseigne la matrice de date
MatriceDate(1, 1) = CDbl(TabMat(j - 2) ^ 3)
MatriceDate(1, 2) = TabMat(j - 2) ^ 2
MatriceDate(1, 3) = CDbl(TabMat(j - 2))
MatriceDate(1, 4) = 1
MatriceDate(2, 1) = CDbl(TabMat(j - 1) ^ 3)
MatriceDate(2, 2) = TabMat(j - 1) ^ 2
MatriceDate(2, 3) = CDbl(TabMat(j - 1))
MatriceDate(2, 4) = 1
MatriceDate(3, 1) = CDbl(TabMat(j) ^ 3)
MatriceDate(3, 2) = TabMat(j) ^ 2
MatriceDate(3, 3) = CDbl(TabMat(j))
MatriceDate(3, 4) = 1
MatriceDate(4, 1) = CDbl(TabMat(j + 1) ^ 3)
MatriceDate(4, 2) = TabMat(j + 1) ^ 2
MatriceDate(4, 3) = CDbl(TabMat(j + 1))
MatriceDate(4, 4) = 1

'On renseigne le vecteur de données
VecTaux(1, 1) = TabData(j - 2)
VecTaux(2, 1) = TabData(j - 1)
VecTaux(3, 1) = TabData(j)
VecTaux(4, 1) = TabData(j + 1)

'Inversion de la matrice de date
MateDateInv = Application.WorksheetFunction.MInverse _
(MatriceDate)

'Résolution du système
VecParam = Application.WorksheetFunction.MMult(MateDateInv, _
VecTaux)

'Calcul de la valeur interpolée
TabRetour(i) = VecParam(1, 1) * TabDates(i) ^ 3 + _
VecParam(2, 1) * TabDates(i) ^ 2 + _
VecParam(3, 1) * TabDates(i) + _
VecParam(4, 1)
End If
Next

InterpolationCubique = TabRetour

End Function

 

[Nul43]

Re : Fontion interpolation cubique

Bonjour,
VBA Excel - Mathématiques financières - InterpolationCubique.
Avez-vous pu exploiter la(les) formules du livre -
en ce qui me concerne si j'exécute le test page 84 - test InterpolationLineaire.
J'obtiens les même résultats en linéaire et cubique.
Si je tente le test sur 1 juin 2008 - je n'obtiens pas 3.94%.
J'ai suivi toute la logique du programme sans déceler un problème.
Votre avis ?
D'avance merci,

Pour info - je passe au test CourbeActualistion ...