pbm fonction interpolation cubique

[kiddus i]

bonjour,
je travaille actuellement sur la création d'un fichier excel de valorisation des instruments de couvertures via vba. j'ai un petit problème avec ma fonction interpolation cubique qui ne fonctionne pas quelqu'un aurait-il une idée.
merci de votre aide

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 MatDateInv 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
MatDateInv = Application.WorksheetFunction.MInverse _
(MatriceDate)

'Résolution du système
VecParam = Application.WorksheetFunction.MMult(MatDateInv, _
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

 

[job75]

Re : pbm fonction interpolation cubique

Bonjour kiddus i,

Pour se passer de macro (de temps en temps ça décongestionne), voici un fichier avec des formules.

A vous de voir ce que vous pouvez en faire.

A+

 

[kiddus i]

Re : pbm fonction interpolation cubique

merci de ton aide🙂