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
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