vba excel反三次樣條插值

Question

我最近遇到了一個數據集問題，因爲它的「分辨率」太小了。該數據集被描述爲具有最大值（0），其實際上並不是它的最大值，因爲所有數字都被歸一化爲在其「分辨率」內找到的較高數字，其基本上是「X」的「1乘1單位」柱。 Y值總是與拋物線曲線相似。

Y  X 
-34,32 -93 
-16,56 -92 
-10,04 -91 
-6,03 -90 
-3,34 -89 
-1,56 -88 
-0,47 -87 
0  -86 
-0,10 -85 
-0,78 -84 
-2,11 -83 
-4,20 -82 
-7,36 -81 
-12,31 -80 
-22,03 -79 
-25,17 -78 

現在，我知道0應該介於0和-0,10之間或0和-0,47之間。線性插值會給我太多的錯誤，所以我想我會使用一個三次樣條。

我需要做的就是計算X參數在我的Ÿ真的是= 0

太糟糕了，我不能用我在互聯網上找到，因爲每次我試圖函數從指定的X計算y1 （下面的代碼示例）。誰能幫忙？

Function SpLine(PeriodCol As Range, RateCol As Range, x As Range) 

Dim Period_Count As Integer 
Dim Rate_Count As Integer 
Dim c As Integer 
Dim n As Integer 
Dim i, k As Integer 
Dim p, qn, sig, un As Single 
Dim klo, khi As Integer 
Dim h, b, a As Single 

' shows the calculation of a cubic spline interpolated value given known values for fixed periods 

Period_Count = PeriodCol.Rows.Count 
Rate_Count = RateCol.Rows.Count 

If Period_Count <> Rate_Count Then 
    SpLine = "Error: Range count dos not match" 
    GoTo endnow 
End If 

ReDim xin(Period_Count) As Single 
ReDim yin(Period_Count) As Single 

For c = 1 To Period_Count 
    xin(c) = PeriodCol(c) 
    yin(c) = RateCol(c) 
Next c 

ReDim u(Period_Count - 1) As Single 
ReDim yt(Period_Count) As Single 
n = Period_Count 
yt(1) = 0 
u(1) = 0 

For i = 2 To n - 1 
    sig = (xin(i) - xin(i - 1))/(xin(i + 1) - xin(i - 1)) 
    p = sig * yt(i - 1) + 2 
    yt(i) = (sig - 1)/p 
    u(i) = (yin(i + 1) - yin(i))/(xin(i + 1) - xin(i)) - (yin(i) - yin(i - 1))/(xin(i) - xin(i - 1)) 
    u(i) = (6 * u(i)/(xin(i + 1) - xin(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 xin(k) > x Then 
     khi = k 
    Else 
     klo = k 
    End If 

    k = khi - klo 
Loop While k > 1 

h = xin(khi) - xin(klo) 
a = (xin(khi) - x)/h 
b = (x - xin(klo))/h 
SpLine = a * yin(klo) + b * yin(khi) + ((a^3 - a) * yt(klo) + (b^3 - b) * yt(khi)) * (h^2)/6 

endnow: 

End Function 

Answer 1

好，因爲沒有人回答，我想我需要找到其他方式。

由於我的值與拋物線曲線的y類似，我找到了一個3階多項式的係數，它近似於這條曲線。

這是通過在細胞中的1×4的陣列填充配方製備：

worksheet.MyRange1x4.formulaarray = "=LINEST(" & MyX & "," & MyY & "^{1,2,3})" 

凡MYX和MYY再次用相同的漁政陣列（1 xn）映射

的結果爲「一「，」b「，」c「和」d「ax^3+bx^2+cx+d

現在，如果我想找到我的最大值的X，我只需要解決一個δ，它非常類似於二次方程：Delta = (-b (+/-) SQRT(b^2 - 3ac))/3a

強迫Delta爲0，我獲得了2個可能的X值（因爲+/- SQRT），其中一個肯定是在我所有接近最大值的範圍內，而另一個完全是錯誤的範圍。

選擇正確的一個讓我終於找到了我的X。