Option Explicit

Function vbaSpline(a As Double, xrange As Object, yrange As Object, zrange As Object) As Double
'   On Error GoTo ErrorLabel
   vbaSpline = 0#
   Dim i%, j%, M%
   M = xrange.Rows.Count * xrange.Columns.Count
   If M < 1 Then
      Exit Function
   End If
   If M = 1 Then
      vbaSpline = yrange(1, 1)
      Exit Function
   End If
   If M <> yrange.Rows.Count * yrange.Columns.Count Or M <> zrange.Rows.Count * zrange.Columns.Count Then
'      MsgBox "error"
      Exit Function
   End If
   Dim x#(), y#(), z#()
   ReDim x(1 To M): ReDim y(1 To M): ReDim z(1 To M)
   For i = 1 To xrange.Rows.Count
      For j = 1 To xrange.Columns.Count
         x((i - 1) * xrange.Columns.Count + j) = xrange(i, j)
      Next j
   Next i
   For i = 1 To yrange.Rows.Count
      For j = 1 To yrange.Columns.Count
         y((i - 1) * yrange.Columns.Count + j) = yrange(i, j)
      Next j
   Next i
   For i = 1 To zrange.Rows.Count
      For j = 1 To zrange.Columns.Count
         z((i - 1) * zrange.Columns.Count + j) = zrange(i, j)
      Next j
   Next i
   If a <= x(1) Then
      vbaSpline = y(1) + z(1) * (a - x(1))
      Exit Function
   End If
   If a >= x(M) Then
      vbaSpline = y(M) + z(M) * (a - x(M))
      Exit Function
   End If
   Dim ij%, d#, e#, f#
   i = 1: j = M
   While j - i > 1
      ij = (i + j) / 2
      If a <= x(ij) Then
         j = ij
      Else
         i = ij
      End If
   Wend
   d = a - x(i)
   e = x(j) - x(i)
   f = (y(j) - y(i)) / e
   vbaSpline = y(i) + d * (z(i) + d * (3 * f - z(j) - 2 * z(i) - d * (2 * f - z(j) - z(i)) / e) / e)
Exit Function
ErrorLabel:
   MsgBox "error in vbaSpline"
   vbaSpline = 0#
End Function


Function vbaParabolicSpline(xrange As Object, yrange As Object) As Variant
'   On Error GoTo ErrorLabel
   Dim i%, j%, M%
   M = xrange.Rows.Count * xrange.Columns.Count
   If M <> yrange.Rows.Count * yrange.Columns.Count Then
'      MsgBox "error"
      Exit Function
   End If
   Dim x#(), y#(), z#()
   ReDim x(1 To M): ReDim y(1 To M): ReDim z(1 To M)
   For i = 1 To xrange.Rows.Count
      For j = 1 To xrange.Columns.Count
         x((i - 1) * xrange.Columns.Count + j) = xrange(i, j)
      Next j
   Next i
   For i = 1 To yrange.Rows.Count
      For j = 1 To yrange.Columns.Count
         y((i - 1) * yrange.Columns.Count + j) = yrange(i, j)
      Next j
   Next i
   Dim dxr#, dyr#, dxl#, dyl#
   dxr = x(2) - x(1): dyr = y(2) - y(1)
   For i = 2 To M - 1
      dxl = dxr: dyl = dyr
      dxr = x(i + 1) - x(i): dyr = y(i + 1) - y(i)
      If i = 2 Then
         z(1) = ((2 * dxl + dxr) * dyl / dxl - dxl * dyr / dxr) / (dxr + dxl)
      End If
      z(i) = (dxl * dyr / dxr + dxr * dyl / dxl) / (dxr + dxl)
   Next i
   z(M) = ((2 * dxr + dxl) * dyr / dxr - dxr * dyl / dxl) / (dxr + dxl)
   vbaParabolicSpline = z
Exit Function
ErrorLabel:
   MsgBox "error in vbaParabolicSpline"
   vbaParabolicSpline = 0#
End Function