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 51 52 53 54 55 56 57 58 59 60 61
|
'Fonction vue ici https://www.business-spreadsheets.com/forum.asp?t=120
'et adaptée pour access
'
Public Function spline(t As Variant, indiceX As Long, indiceY As Long, x As Double) As Double
Dim val1 As Integer
Dim val2 As Integer
Dim n As Integer
Dim i As Integer, k As Integer
Dim p As Single, qn As Single, sig As Single, un As Single
Dim u() As Single
Dim yt() As Single
Dim y As Double
Dim klo As Integer, khi As Integer
Dim h As Single, b As Single, a As Single
val1 = UBound(t) - 1
val2 = UBound(t)
n = UBound(t)
ReDim u(val1)
ReDim yt(val2)
yt(1) = 0
u(1) = 0
For i = 2 To n - 1
sig = (t(indiceX, i) - t(indiceX, i - 1)) / (t(indiceX, i + 1) - t(indiceX, i - 1))
p = sig * yt(i - 1) + 2
yt(i) = (sig - 1) / p
u(i) = (t(indiceY, (i + 1)) - t(indiceY, i)) / (t(indiceX, (i + 1)) - t(indiceX, i)) - (t(indiceY, i) - t(indiceY, (i - 1))) / (t(indiceX, i) - t(indiceX, (i - 1)))
u(i) = (6 * u(i) / (t(indiceX, (i + 1)) - t(indiceX, (i - 1))) - sig * u(i - 1)) / p
Next i
qn = 0
un = 0
yt(n) = (un - qn * u(n - 1)) / (qn * yt(n - 1) + 1)
For k = n - 1 To 1 Step -1
yt(k) = yt(k) * yt(k + 1) + u(k)
Next k
klo = 1
khi = n
Do
k = khi - klo
If t(indiceX, k) > x Then
khi = k
Else
klo = k
End If
k = khi - klo
Loop While k > 1
h = t(indiceX, khi) - t(indiceX, klo)
a = (t(indiceX, khi) - x) / h
b = (x - t(indiceX, klo)) / h
y = a * t(indiceY, klo) + b * t(indiceY, khi) + ((a ^ 3 - a) * yt(klo) + (b ^ 3 - b) * yt(khi)) * (h ^ 2) / 6
spline = y
End Function |
Partager