ステートメント制御文の使用例13


使用例13

回帰分析により実験データの近似直線を求める (難問)

次図の 10個の実験データ(Y軸)から、回帰直線(近似直線) y=a+bx を求め ることを考える。事前に Excel 上で、[ツール] - [アドイン] をクリックし て、「分析ツール」 と 「分析ツール - VBA」 の二ヶ所にチェックを入れ 'Microsoft Office 2000' の CD-ROM からインストールしておく。  図1

bottom top Excel のアドイン機能による方法 --------------------------------- Excel - [ツール] - [分析ツール] - [回帰分析] とクリックして選択する。 次に、[入力元] の 「入力Y範囲」 で 上図の B列のY軸データを選択し、 「入力X範囲」 で A列のX軸データを選択すると、新規シートに次の表が 自動的に追加される。 図2に見える 切片 の係数が、回帰直線 y=a+bx の 定数項 a で、X値1 の係数が 一次項 b である。  図2

bottom top Excel VBA による方法 ---------------------- 次のコードは、下記URL を参考にした。このコードを実行すると、上図1の データ行の下の行のセル範囲 A14〜B15 に、一次項と定数項の値を算出する。 Private Sub test1() Dim matX As Variant Dim matY As Variant Dim matC As Variant Dim Dn As Long Dim Lr As Long Dim Ri As Long 'データ設定 With Sheet1 Lr = .Range("A1").End(xlDown).Row matX = .Range("A2:A" & Lr).Value matY = .Range("B2:B" & Lr).Value End With Dn = Lr - 1 '定数項の設定 ReDim Preserve matX(1 To Dn, 1 To 2) For Ri = 1 To Dn matX(Ri, 2) = 1 Next '関数 matC = CalcCoefficients(matX, matY) '出力 With Sheet1 .Range("B14:B15").Value = matC .Range("A14").Value = "一次項" .Range("A15").Value = "定数項" End With End Sub '回帰計算の定義関数 Function CalcCoefficients(matX As Variant, _ matY As Variant) As Variant Dim mat1 As Variant Dim mat2 As Variant Dim mat3 As Variant Dim mat4 As Variant Dim mat5 As Variant '回帰計算 (下記の補足1参照) With WorksheetFunction mat1 = .Transpose(matX) '転置行列 mat2 = .MMult(mat1, matX) '行列の積 mat3 = .MMult(mat1, matY) '行列の積 mat4 = .MInverse(mat2) '逆行列 mat5 = .MMult(mat4, mat3) '行列の積 End With CalcCoefficients = mat5 End Function (下記の補足1 参照) bottom top Excel 関数による方法 ---------------------- Excel のアドイン(図1)、VBA(図2) のいずれの方法も、回帰直線 として y=5.2+0.745454545x が得られた。これを、下記書籍の 141〜145ページ [回帰係数の推定検定、最小二乗法] の解説を元に、Excel 関数を用いて 手計算で求めてみる。その結果が次の図3である。  図3

(補足1)

(補足2)

(補足3) 回帰曲線(近似曲線) も参照のこと。 《参考書籍》  統計数学入門 (数学ライブラリー18)  本間鶴千代著, 森北出版 《参考URL》  MOUG(モーグ) Microsoft Office Users Group Q&A 掲示板  http://www2.moug.net/cgi-bin/mdboard.cgi?exvba+ID0001 back top