Excel2000マクロ 2つの近似線の接点を求める。

質問

何方か、回答を宜しくお願いします。
下記のデータを使用して2つの近似線を散布図上に表示しました。
この時の、2つの近似線の接点の値（下記の場合xが6位、Yが15.1位）を
何処かのセルに出したいのですが（出来ればマクロ）どうも私の頭では
限界になりましたので有識者の方々宜しくお願いします。
-----------------------------------------
近似線1は、A1:A5、B1:B5
近似線2は、A8:A12、B8:B12
---------------------------------------
傾き　=SLOPE(B1:B5,A1:A5)
切片　=INTERCEPT(B1:B5,A1:A5)
-------------------------------------
A列（X）＿＿B列（Y）
1＿＿＿＿10.1
2＿＿＿＿10.9
3＿＿＿＿12.1
4＿＿＿＿12.9
5＿＿＿＿14.1
6＿＿＿＿空白
7＿＿＿＿空白
8＿＿＿＿15.1
9＿＿＿＿14.9
10＿＿＿＿15.1
11＿＿＿＿14.9
12＿＿＿＿15.1

回答No.2

KenKen_SP · ベストアンサー

数学は苦手です....

> 近似線1は、A1:A5、B1:B5で前回と同じ、

直線の方程式：　y = Ax + B

・近似線1（直線？） A1:A5、B1:B5
　傾きA　=SLOPE(B1:B5,A1:A5)　　　--->1
　切片B　=INTERCEPT(B1:B5,A1:A5)　--->9.02

　なので、

　y = x + 9.02　---　(1)

> 近似線2の方が今回変わってY値が固定で（今回は12）Xの値を調べる計算式

　X 値の変化に係わらず常に Y 値が 12 ...これって傾き 0 のことですよね？
　つまり、

　y = 0x + 12 ---> y = 12

　単純に(1)の数式に y を代入するだけじゃ？

　12 = x + 9.02
　x = 12 - 9.02
　x = 2.98

です。#1 の回答を生かすなら、ワークシート上で

A列（X）＿＿B列（Y）
1＿＿＿＿10.1
2＿＿＿＿10.9
3＿＿＿＿12.1
4＿＿＿＿12.9
5＿＿＿＿14.1
6＿＿＿＿空白
7＿＿＿＿空白
8＿＿＿＿12
9＿＿＿＿12
10＿＿＿＿12
11＿＿＿＿12
12＿＿＿＿12

とデータ修正するだけです。

余談ですが、連立方程式を VBA で解くには...

　　y = Ax + B
　　y = Cx + D

　　Ax + B = Cx + D
　　(A - C)x = (D - B)
　　x = (D - B) / (A - C)

で x 値が求まりますので、それを元の方程式のどちらかに代入すれば y
が決まります。

ワークシート上の数式で十分解を求めることは可能ですが、#1 は VBA で...
というご希望だったので、上記をそのまま VBA で書いてるだけです。

それほど難しいことをやっているわけではありません。じっくりと、#1 の
コードがどのような仕組みになっているのか、ご自分で考えてみて下さい。
大丈夫。きっと難しそうに見えてるだけです。

> 出来れば逆のパターンでX値が固定でYの値を調べる計算式も欲しいです。

考え方さえわかってしまえば、あとは応用です。頑張って下さいね(^^)ノ

お礼

KenKen_SP様回答ありがとう御座います。
私の弱い頭でもようやくX値は出すことが出来ました。
（でも、Y値の方はまだです。）
今回も、勉強になる回答ありがとう御座いました。

回答No.1

KenKen_SP

すみません、正直 Slope とか近似線とか良くわかってないですけど。

> 傾き　=SLOPE(B1:B5,A1:A5)
> 切片　=INTERCEPT(B1:B5,A1:A5)

これで、各線の正しい傾きと切片が得られるのであれば、次のような
感じでどうですか？ 私にはこれが正しいのかどうかもわかりません
が、２直線の交点を求めるということであれば、得られた直線の連立
方程式をそのまま解けば良い気がします。

Sub Test()

　　Dim a1 As Double, b1 As Double
　　Dim a2 As Double, b2 As Double
　　Dim x　As Double, y　As Double

　　'傾き　=SLOPE(B1:B5,A1:A5)
　　'切片　=INTERCEPT(B1:B5,A1:A5)
　　a1 = Application.Slope(Range("B1:B5"), Range("A1:A5"))
　　b1 = Application.Intercept(Range("B1:B5"), Range("A1:A5"))

　　'傾き　=SLOPE(B8:B12,A8:A12)
　　'切片　=INTERCEPT(B8:B12,A8:A12)
　　a2 = Application.Slope(Range("B8:B12"), Range("A8:A12"))
　　b2 = Application.Intercept(Range("B8:B12"), Range("A8:A12"))

　　x = (b2 - b1) / (a1 - a2)
　　y = a1 * x + b1

　　MsgBox "X:=" & CStr(x) & vbLf & "Y:=" & CStr(y)

End Sub

お礼

KenKen_SP様回答ありがとう御座います。
接点の値がxが5.999位、Yが15.02とバッチリでした。
直線の連立方程式を使うのですね、良い勉強になりましたありがとう御座います。
（補足で又質問するかも知れませんがその時は宜しくお願いします。）

補足

KenKen_SP様宜しければ計算式を教えて下さい。
近似線1は、A1:A5、B1:B5で前回と同じ、近似線2の方が今回変わって
Y値が固定で（今回は12）Xの値を調べる計算式を教えて下さい。
（出来れば逆のパターンでX値が固定でYの値を調べる計算式も欲しいです。）
宜しくお願いします。