[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『任意の配列を補完して、関数の様に扱うには？』（Ktng）
長文となり、恐縮です。
現在、私は下記の内容を思案中ですが、妙案が思いつきません。
下記内容が、出来れば、理系で助かる人も多いのではと思い投稿させて頂きます。
よろしくお願いします。
未知の関数Y=f(X)で示される
下の様なデータ(m,n)を測定したとします。
下記の様に、(m,n)は、それぞれ、セル(A3,B3)から、セル(An,Bn)まで、入力されています。
ただ、mの間隔は一定間隔と言うわけでも有りません。
ここで、データ(m,n)系列を用いて、任意のxの時のyの値をY=f(X)の様に求めたいです。
求めたいxは
m, x, M, M' の様に並んで居るとして、
求めるに当たっては、(m,f(m)), (M, f(M)), (M' ,f(M'))の3つを用います。
補完の方法は、この3つの(x,y)より二次関数のabcを求めます。その二次関数を求めて、yを計算したいです。
例えば、下表において x=105の時に前後の値を用いてf(105)=?
を補完して求める様な式はどの様になりますでしょうか？
補完に使用する値は、
(100,m)
(110,M)
(122,M')
の3点を用いて、
100-105(所謂x)-110-122
の様に、なっていて、 m、 M、
M'より二次関数のabcを求めます。
y=ax^2+bx+c に105を当てはめてyを求める様にしたいです。
何卒、よろしくお願いします。
AB
x y
1 a
2 b
4 c
9 d
:
100 m
110 M
122 M'
:
n N
＜ 使用 Excel：Excel2013、使用 OS：Windows7 ＞
（マナ） 2015/09/02(水) 22:07
苦手分野ですが、教科書ひっぱりだしできて、 ちょっとのつもりが、午前中からかかりきりで、疲れました…。
ユーザー定義関数です：Ktng(rngXY, x)
・一つ目の引数rngXYは、既知の(x,y)の組み合わせ ・２次回帰式なので、最低３組のデータが必要 ・１列目がｘ，２列目がy ・２つ目の引数が、計算したいｘ ・３次、４次の式に対応可能なように修正するには、引数ふやす
A B C D 1 既知ｘ 既知ｙ ｘ f(x) 2 100 2 105 =ktng($A$2:$B$5,C2) 3 110 3 4 120 5 5 130 7
Function Ktng(rngXY As Range, x)
Dim Data
Dim S() As Double
Dim T(1 To 3, 1 To 3) As Double
Dim U(1 To 3, 1 To 3) As Double
Dim p(1 To 3) As Double
Dim n As Long, m As Long
Dim i As Long, j As Long, k As Long
If rngXY.Columns.Count <> 2 Then Ktng = "err": Exit Function
n = rngXY.Rows.Count
If n < 3 Then Ktng = "err": Exit Function
ReDim S(1 To n + 1, 1 To 7)
m = n
Data = rngXY.Value
For i = 1 To n
If IsNumeric(Data(i, 1)) = True And IsEmpty(Data(i, 1)) = False _
And IsNumeric(Data(i, 2)) = True And IsEmpty(Data(i, 2)) = False Then
S(i, 1) = Data(i, 1) 'X
S(i, 5) = Data(i, 2) 'Y
Else
m = m - 1 '有効なデータ数
End If
Next
If m < 3 Then Ktng = "err": Exit Function
For i = 1 To n
For j = 2 To 4 'X^2, X^3. X^4
S(i, j) = S(i, 1) ^ j
Next
For j = 6 To 7 'YX, YX^2
S(i, j) = S(i, 5) * S(i, j - 5)
Next
Next
For j = 1 To 7
For i = 1 To n
S(n + 1, j) = S(n + 1, j) + S(i, j)
Next
Next
For i = 1 To 3
For j = 1 To 3
k = i + j - 2
If k = 0 Then
T(i, j) = m
Else
T(i, j) = S(n + 1, k)
End If
Next
U(i, 1) = S(n + 1, i + 4)
Next
With WorksheetFunction
For i = 1 To 3
p(i) = .Index(.MMult(.MInverse(T), U), i, 1)
Next
End With
For i = 1 To 3
Ktng = Ktng + p(i) * x ^ (i - 1)
Next
End Function
（マナ） 2015/09/06(日) 19:56
Function Ktng2(rngXY As Range, x As Double, Optional d As Long = 2)
Dim Data
Dim Sx() As Double
Dim Sy() As Double
Dim p() As Double
Dim n As Long, m As Long
Dim i As Long, j As Long
If rngXY.Columns.Count <> 2 Then Ktng2 = "err": Exit Function
n = rngXY.Rows.Count
If n < d + 1 Then Ktng2 = "err": Exit Function
ReDim Sx(1 To d, 1 To n)
ReDim Sy(1 To 1, 1 To n)
Data = rngXY.Value
For i = 1 To n
If IsNumeric(Data(i, 1)) = True And IsEmpty(Data(i, 1)) = False _
And IsNumeric(Data(i, 2)) = True And IsEmpty(Data(i, 2)) = False Then
m = m + 1 '有効なデータ数
For j = 1 To d
Sx(j, m) = Data(i, 1) ^ j 'X. X^2,…, X^d
Next
Sy(1, m) = Data(i, 2) 'Y
End If
Next
If m < d + 1 Then Ktng2 = "err": Exit Function
ReDim Preserve Sx(1 To d, 1 To m)
ReDim Preserve Sy(1 To 1, 1 To m)
ReDim p(0 To d)
With WorksheetFunction
For i = 0 To d
p(i) = .Index(.LinEst(.Transpose(Sy), .Transpose(Sx)), i + 1)
Next
End With
For i = 0 To d
Ktng2 = Ktng2 + p(i) * x ^ (d - i)
Next
End Function
（マナ） 2015/09/12(土) 16:46
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.