为什么我的样条函数不起作用？

Question

我在使用net..dias（days）和taxas（rate）是我的电子表格的两个数组中找到样条函数时遇到了一些问题，而T是我想知道相应速率的天数。当我使用这个函数设置函数内的数组时，它工作得很好......但是使用电子表格数组VBA让我难过，因为它不能找到项目或库..有人可以帮助我吗？由于

Function NDF6(T, dias, taxas) 
Dim x As Variant 
x = T 
Dim xin() As Variant 
Dim yin() As Variant 
Dim input_count As Integer 
Dim output_count As Integer 
input_count = dias.Count 
output_count = taxas.Count 

ReDim xin(input_count) 
ReDim yin(output_count) 
Dim c As Integer 
For c = 1 To input_count 
    xin(c) = dias(c) 
    yin(c) = taxas(c) 
Next c 

      'values are populated 

    Dim n As Integer 'n=input_count 
Dim i, k As Integer 'these are loop counting integers 
Dim p, qn, sig, un As Variant 
Dim u() As Variant 
ReDim u(input_count - 1) As Variant 
Dim yt() As Variant 'these are the 2nd deriv values 
ReDim yt(output_count - 1) As Variant 
Dim y As Double 

    n = input_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 

    'now eval spline at one point 

    Dim klo, khi As Integer 
    Dim h, b, a As Single 
    ' first find correct interval 
    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 
    y = a * yin(klo) + b * yin(khi) + ((a^3 - a) * yt(klo) + (b^3 - b) * yt(khi)) * (h^2)/_ 6 

    NDF6 = y 

    End Function 

Answer 1

你可以使用我的代码：

片与计算得到：

：

Public Sub TestSpline() 

    Dim x() As Variant, y() As Variant, ypp() As Variant 
    Dim xe() As Variant, ye() As Variant 

    x = [B2].Resize(13, 1).Value 
    y = [C2].Resize(13, 1).Value 
    xe = [N2].Resize(49, 1).Value 

    CalculateYpp x, y, ypp 
    CalculatePoints x, y, ypp, xe, ye 

    [O2].Resize(49, 1).Value = ye 

End Sub 

和三次样条计算是在做

Public Sub CalculateYpp(ByRef x() As Variant, ByRef y() As Variant, ByRef ypp() As Variant, Optional dydx_1 As Variant = vbNullString, Optional dydx_N As Variant = vbNullString) 

    Dim N As Integer, Z As Integer 
    'calculate 2nd derivatives 
    N = UBound(x, 1): Z = UBound(y, 2) 
    ReDim ypp(1 To N, 1 To Z) 

    Dim u() As Variant 
    ReDim u(1 To N, 1 To Z) 
    Dim i As Integer 
    For i = 1 To Z 
     If Not IsNumeric(dydx_1) Then 
      ypp(1, i) = 0# 
      u(1, i) = 0# 
     Else 
      ypp(1, i) = -0.5 
      u(1, i) = 3#/(x(2, 1) - x(1, 1)) * ((y(2, i) - y(1, i))/(x(2, 1) - x(1, 1)) - CDbl(dydx_1)) 
     End If 

     Dim k As Integer 
     Dim sig As Variant 
     Dim P As Variant, hn As Variant, hi As Variant 
     For k = 2 To N - 1 Step 1 
      hi = x(k, 1) - x(k - 1, 1) 
      hn = x(k + 1, 1) - x(k, 1) 
      sig = hi/(hn + hi) 
      P = sig * ypp(k - 1, 1) + 2# 
      ypp(k, i) = (sig - 1#)/P 
      If Abs(hn) > 0 And Abs(hi) > 0 Then 
       u(k, i) = (6# * ((y(k + 1, i) - y(k, i))/hn - (y(k, i) - y(k - 1, i))/hi) _ 
         /(hn + hi) - sig * u(k - 1, i))/P 
      ElseIf Abs(hi) > 0 Then 
       u(k, i) = (6# * (-(y(k, i) - y(k - 1, i))/hi)/(hn + hi) - sig * u(k - 1, i))/P 
      ElseIf Abs(hn) > 0 Then 
       u(k, i) = (6# * ((y(k + 1, i) - y(k, i))/hn)/(hn + hi) - sig * u(k - 1, i))/P 
      Else 
       u(k, i) = -sig * u(k - 1, i)/P 
      End If 
     Next k 
     Dim qn As Variant 
     If Not IsNumeric(dydx_N) Then 
      qn = 0# 
      u(N, i) = 0# 
     Else 
      qn = 0.5 
      u(N, i) = 3#/(x(N, 1) - x(N - 1, 1)) * (CDbl(dydx_N) - (y(N, i) - y(N - 1, i))/_ 
          (x(N, 1) - x(N - 1, 1))) 
     End If 
     ypp(N, i) = (u(N, i) - qn * u(N - 1, i))/(qn * ypp(N - 1, i) + 1#) 
     For k = N - 1 To 1 Step -1 
      ypp(k, i) = ypp(k, i) * ypp(k + 1, i) + u(k, i) 
     Next k 

    Next i 'Next Column 

End Sub 

Public Function IndexOf(ByRef x() As Variant, ByVal x_value As Variant) As Integer 
    Dim K1 As Integer, K2 As Integer, k As Integer, N As Integer 
    N = UBound(x, 1) 
    'Do bisection to find index of xi() 
    K1 = 1 
    K2 = N 
    Do While (K2 - K1) > 1 
     k = (K1 + K2)/2 
     If (x(K1, 1) - x_value) * (x(k, 1) - x_value) <= 0 Then 
      K2 = k 
     Else 
      K1 = k 
     End If 
    Loop 
    k = K1 
    If k > N - 1 Then k = N - 1 

    IndexOf = k 
End Function 

Public Sub CalculatePoints(ByRef x() As Variant, ByRef y() As Variant, ByRef ypp() As Variant, ByRef xe() As Variant, ByRef ye() As Variant) 
    Dim i As Integer, k As Integer, K1 As Integer 
    Dim N As Integer, Z As Integer 
    N = UBound(xe, 1): Z = UBound(y, 2) 
    ReDim ye(1 To N, 1 To Z) 

    Dim x1 As Variant, y1 As Variant, y1pp As Variant 
    Dim x2 As Variant, y2 As Variant, y2pp As Variant 
    Dim A As Variant, b As Variant, h As Variant, C As Variant, D As Variant 

    For i = 1 To Z 
     For k = 1 To N 
      K1 = IndexOf(x, xe(k, 1)) 
      x1 = x(K1, 1) 
      x2 = x(K1 + 1, 1) 
      y1 = y(K1, i) 
      y2 = y(K1 + 1, i) 
      y1pp = ypp(K1, i) 
      y2pp = ypp(K1 + 1, i) 
      h = x2 - x1 
      A = (x2 - xe(k, 1))/h 
      b = (xe(k, 1) - x1)/h 
      C = (A * A * A - A) * h^2/6# 
      D = (b * b * b - b) * h^2/6# 

      ye(k, i) = y1 * A + y2 * b + y1pp * C + y2pp * D 
     Next k 
    Next i 
End Sub 

它甚至可以用于多列y和ye。