1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
| Function FracInterpCoef(xi, yi, Optional DgtMax)
'returns the coefficients of continue fraction interpolation
'y = a0 + (x-x1)/(a1+(x-x2)/(a2+(x-x3)/(a3+...)))
Const tiny = 10 ^ -15
Dim vx(), vy(), coeff
If IsMissing(DgtMax) Then DgtMax = 0
If DgtMax = 0 Then
On Error GoTo Error_Handler
LoadVector vx, xi, nx
LoadVector vy, yi, ny
If nx <> ny Then FracInterpCoef = "?": Exit Function
Cont_Fraction_Coeff vx, vy, coeff, tiny
FracInterpCoef = PasteVector_(coeff)
Else
FracInterpCoef = xFract_Interp_Coef(xi, yi, DgtMax)
End If
Exit Function
Error_Handler:
FracInterpCoef = "?"
End Function
Sub LoadVector(vector, obj, n, Optional opt_base)
'Trasform something (?!) (range, matrix, vector, etc.) into vector
'modified 28-9-02
If IsMissing(opt_base) Then opt_base = 1
If IsObject(obj) Then
'Vector is selected range
Dim area As Range
Set area = obj
If area.Columns.Count = 1 Then
rows_max = ActiveSheet.Rows.Count
n = area.Cells.Count
k = 0
If n = rows_max Then
'full column selected. Example: (A:A)
n = area.End(xlDown).row
If area.Cells(2) = "" And n = rows_max Then n = 1 'empty column
'eliminate title cell
If xIsNumeric(area.Cells(1)) = 0 Then
n = n - 1: k = 1
End If
End If
If n < 1 Then Exit Sub
tmp = area
ReDim vector(opt_base To n + opt_base - 1)
If n = 1 Then 'bug for one cell selected. thanks to David Sloan 28-9-02
vector(opt_base) = tmp
Else
For i = 1 To n
vector(i + opt_base - 1) = tmp(i + k, 1)
Next i
End If
Else
col_max = ActiveSheet.Columns.Count
n = area.Cells.Count
k = 0
If n = col_max Then
'full row selected. Example: (2:2)
n = area.End(xlToRight).Column
If area.Cells(2) = "" And n = col_max Then n = 1
'eliminate title cell
If xIsNumeric(area.Cells(1)) = 0 Then
n = n - 1: k = 1
End If
End If
If n < 1 Then Exit Sub
tmp = area
ReDim vector(opt_base To n + opt_base - 1)
For i = 1 To n
vector(i + opt_base - 1) = tmp(1, i + k)
Next i
End If
ElseIf IsMatrix(obj) Then
'check dimension
If UBound(obj, 1) > UBound(obj, 2) Then
'vector column
n = UBound(obj, 1)
ReDim vector(opt_base To n + opt_base - 1)
For i = 1 To n: vector(i + opt_base - 1) = obj(i, 1): Next
Else
'vector row
n = UBound(obj, 2)
ReDim vector(opt_base To n + opt_base - 1)
For i = 1 To n: vector(i + opt_base - 1) = obj(1, i): Next
End If
ElseIf IsVector(obj) Then
'true vector (finally!)
n = UBound(obj)
ReDim vector(opt_base To n + opt_base - 1)
For i = 1 To n: vector(i + opt_base - 1) = obj(i): Next
Else
n = 1 'a single number probably 29-6-2003 VL
ReDim vector(opt_base To n + opt_base - 1)
vector(1 + opt_base - 1) = obj
End If
End Sub |
