Sulprobil
Search…
sbInterp
"Write what you know. That should leave you with a lot of free time." [Howard Nemerov]
If you have a given set of known (x, y) points and you need to know y-parts of other given x parts then you need to interpolate. It is similar to filling gaps of a table:
Please read my Disclaimer.
1
Function sbInterp(vX As Variant, vY As Variant, _
2
vT As Variant, _
3
Optional sType As String = "Linear", _
4
Optional bExtrapolate As Boolean = True, _
5
Optional sExtraType As String) As Variant
6
'Interpolates y-values for target values vT with known
7
'y-values vY and known x-values vX with type sType.
8
'sType can be:
9
'Const or C
10
'Linear or L
11
'LinearInVariance or LIV
12
'Extrapolation will be done if bExtrapolate is TRUE.
13
'Extrapolation type sExtraType defaults to sType if empty.
14
'Values in vX must be 'in ascending order. #VALUE! error
15
'indicates illegal sType, #NUM! error indicates that
16
'extrapolation has been switched off and #N/A tells you
17
'that x-values are not given in increasing order.
18
'Reverse(moc.liborplus.www) V0.5 PB 14-Oct-2012
19
Dim i As Long, iX As Long, iT As Long, k As Long
20
Dim vTk, vXi
21
Dim sT As String 'Type of inter- or extrapolation
22
Dim sEType As String 'Extrapolation type
23
24
On Error Resume Next
25
iX = vX.Count
26
iX = UBound(vX)
27
iT = vT.Count
28
iT = UBound(vT)
29
On Error GoTo 0
30
ReDim vR(1 To iT) As Variant
31
With Application.WorksheetFunction
32
If iX < 2 Then
33
sbInterp = CVErr(xlErrNA)
34
Exit Function
35
Else
36
For k = 2 To iX
37
If vX(k) <= vX(k - 1) Then
38
sbInterp = CVErr(xlErrNA)
39
Exit Function
40
End If
41
Next k
42
End If
43
If sExtraType = "" Then
44
sEType = sType 'Same as interpolation type
45
Else
46
sEType = sExtraType
47
End If
48
For k = 1 To iT
49
i = 0
50
vTk = 0
51
vXi = 0
52
On Error Resume Next
53
i = .Match(vT(k), vX, 1)
54
vTk = vT(k)
55
vXi = vX(i)
56
On Error GoTo 0
57
If Not bExtrapolate And _
58
(i = 0 Or (i = iX And vTk <> vXi)) Then
59
vR(k) = CVErr(xlErrNum)
60
Else
61
sT = sType 'Set to interpolation type
62
If i = 0 Then
63
i = 1
64
sT = sEType 'Set to extrapolation type
65
End If
66
If i = iX Then
67
i = i - 1
68
If vTk <> vXi Then
69
sT = sEType 'Set to extrapolation type
70
End If
71
If sT = "C" Or sT = "Const" Then i = i + 1
72
End If
73
Select Case sT
74
Case "C", "Const"
75
vR(k) = .Index(vY, i)
76
Case "L", "Linear"
77
vR(k) = .Index(vY, i) + (vTk - .Index(vX, i)) _
78
* (.Index(vY, i + 1) - .Index(vY, i)) _
79
/ (.Index(vX, i + 1) - .Index(vX, i))
80
Case "LIV", "LinearInVariance"
81
On Error Resume Next
82
vR(k) = Sqr(.Index(vY, i) ^ 2# + (vTk - .Index(vX, i)) _
83
* (.Index(vY, i + 1) ^ 2# - .Index(vY, i) ^ 2#) _
84
/ (.Index(vX, i + 1) - .Index(vX, i)))
85
On Error GoTo 0
86
Case Else
87
sbInterp = CVErr(xlErrValue)
88
Exit Function
89
End Select
90
End If
91
Next k
92
If TypeName(Application.Caller) = "Range" Then
93
If Application.Caller.Rows.Count > _
94
Application.Caller.Columns.Count Then
95
vR = .Transpose(vR)
96
End If
97
End If
98
End With
99
sbInterp = vR
100
End Function
Copied!
If you cannot or if you do not want to use macros, you might want to interpolate with these worksheet functions (poor you):
Poor man's interpolation (PERCENTILE / PERCENTRANK approach)
Poorest man's interpolation (piecewise TREND approach)
If you are lucky and your slopes between adjacent points are monotonously increasing or decreasing you can apply the funnily short MiniMax Interpolation.
If you like to fill gaps with linear interpolation using worksheet functions, look here.
Last modified 1yr ago
Copy link