调用样条函数时函数的结果给出了错误的值

时间:2014-09-24 19:15:18

标签: vba

我有一个只在某事发生时调用样条函数的函数。在这种情况下,当除法小于零时...函数的输入与样条函数(称为CUBIC)的相同,样条函数经过测试,我直接称之为效果很好!有人可以帮助我吗?...跟随代码的一方

   Function NDF6(T As Variant, dias As Variant, taxas As Variant)
     If T <= dias(1) Then
    NDF6 = taxas(1)
    Exit Function
   End If
 If T >= dias(tam) Then
    NDF6 = taxas(tam)
    Exit Function
End If
For i = 1 To tam
    If T <= dias(i) Then
        If taxas(i) / taxas(i - 1) < 0 Then
            Call CUBIC(T, dias, taxas)
        Else
            i0 = ((taxas(i - 1) * dias(i - 1)) / 360) + 1
            i1 = ((taxas(i - 1) * dias(i - 1)) / 360) + 1
            irel = i1 / i0
            i2 = irel ^ ((T - dias(i - 1)) / (dias(i) - dias(i - 1)))
            i2rel = i2 * i0
            i2real = i2rel - 1
            NDF6 = i2real * (360 / T)
       End If
 Public Function CUBIC(x As Variant, input_column As Variant, output_column As Variant)

1 个答案:

答案 0 :(得分:0)

当我调用三次函数时,函数返回零值。输入是一个值为一天的值的单元格,两个数组(DUONOFF和ONOFF)相当于一天和费率,我称之为函数:

NDF6(512,DUONOFF,ONOFF)

遵循CUBIC函数

  Public Function CUBIC(x As Variant, input_column As Variant, output_column As Variant)
  'Purpose: Given a data set consisting of a list of x values
 ' and y values, this function will smoothly interpolate
  ' a resulting output (y) value from a given input (x) value

  ' This counts how many points are in "input" and "output" set of data
  Dim input_count As Integer
  Dim output_count As Integer
  input_count = input_column.Rows.Count
   output_count = output_column.Rows.Count
   Next check to be sure that "input" # points = "output" # points
   If input_count <> output_count Then
  CUBIC = "Something's messed up! The number of indeces number of output_columnues don't match!"
  GoTo out
  End If

  ReDim xin(input_count) As Single
  ReDim yin(input_count) As Single
  Dim c As Integer
  For c = 1 To input_count
  xin(c) = input_column(c)
  yin(c) = output_column(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 Single
 ReDim u(input_count - 1) As Single
 ReDim yt(input_count) As Single 'these are the 2nd deriv values
 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

     CUBIC = y
    out:
     End Function