Excel 2007 ＜マクロで逆行列を求めたい＞

質問

Excel 2007 ＜マクロで逆行列を求めたい＞

任意のn次の正方行列の逆行列をシートを介さずマクロ上のみで求めたいのです。

たとえば

Option Base 1
Sub test()
　dim a() as single
　dim b() as single
　n=5
　redim a(n,n) '行列A
　redim b(n,n) '行列B

　for i=1 to n
　　for j=1 to n
　　　....'a(i,j)に値が入る
　　next j
　next i

　....
　.... 'Aの逆行列の要素がBの要素になる。

End Sub　

というマクロです。
（行列Aは逆行列を持つという前提で話を進めます）

以下のサイトより、シートに値があれば、Rangeオブジェクト及びWorksheetFunctionを用いて逆行列を求められることが分かりました。

http://makotowatana.ld.infoseek.co.jp/vba_cell.html

そこでもう一歩踏み込んで、シートを介さずして逆行列の要素を、取得したいのですが、可能でしょうか？

ご存知の方よろしくお願いします。

回答No.3

Wendy02 · ベストアンサー

>「係数」及び「係数の逆行列」がRANGEではないとだめなのかという趣旨でした。
MInverse 関数の引数は、本来Range 型ではなく、N×N型の配列です。関数の中で、一旦、Range型を配列に変換していますが、2辺の長さ・高さの同じマトリックスの配列なら、そのまま入ります。

>「係数」へ行列の配列の格納方法が分かれば解決しそうです。
セルからでしたら、ループは不要です。

なお、Option Base 1を使わないのは、上位のVB.Net には存在しないので、この先、互換性に近づけるために、使わないようにしています。VBAは、当分の間変わらないとは言われていますが。VBAでは、1から始まるものは、コレクション、0から始まるものは、配列と理解していたほうが問題が少ないです。

一応、URL先のコードは、気になる部分があったので、こちらで作ってみました。ある程度、VBAが書けるようになったら、2バイト文字の変数は使いません。(開発をするような環境の人だけですが、変数など、文字化けを起こして、さっぱり分からなくなってしまうからです。また、使えない2バイト文字があると聞きますが、その内容は詳しくは知りません。）

'//
Sub Simul_Equation_Resolving()
　Dim rng As Range
　Dim rng2 As Range
　Dim Ar As Variant
　Dim Ar2 As Variant
　Dim Ret As Variant
　Dim cnt As Long

'データ(この場合は、明示的にいれたほうがよい）
　Set rng = Range("A2:C4") '係数の数値
　Set rng2 = Range("G2:G4") '右辺

'エラーチェック(正しければ、直接配列の準備に入れてもよい）
　If rng.Rows.Count <> rng.Columns.Count Or _
　　WorksheetFunction.CountA(rng) <> WorksheetFunction.Count(rng) Or _
　　WorksheetFunction.Count(rng) = 0 Then
　　MsgBox "数値のみの四角形の範囲を選択してください。", vbExclamation
　　Exit Sub
　End If
　If WorksheetFunction.MDeterm(rng) = 0 Then
　　MsgBox "解がありません。", vbExclamation
　　Exit Sub
　End If
　cnt = rng2.Rows.Count
　If rng.Rows.Count <> cnt Or _
　　 WorksheetFunction.Count(rng2) <> cnt Then
　　MsgBox "右辺の数が違うか、並びが違うか、文字が含まれています。", vbExclamation
　　Exit Sub
　End If
　'配列の準備
　　Ar = rng.Value
　　Ar2 = rng2.Value
　'解を求める関数
　With WorksheetFunction
　　Ret = .MMult(.MInverse(Ar), Ar2)
　End With
　'出力
　If IsArray(Ret) Then
　　Range("Q2").Resize(cnt).Value = Ret
　End If
　Set rng = Nothing
　Set rng2 = Nothing
End Sub
'//
URL先のコードの訂正
ThisWorkbook.Worksheets("sheet1").Activate ←これは要りません。
ReDim 係数(r, r)　　'ここは不要です。

以下は間違いではありませんが、元の表の場合は、上手くありません。
r = Range("A2").End(xlDown).Row - 1 '方程式の行数
　　　　↓
r = Range("A2", Range("A2").End(xlDown)).Rows.Count　'このようにしたほうがよいです。

Dim 係数の行列式 As Double　←Double型にする意味がありません。入れるなら、Variant 型です。

係数の行列式 = WorksheetFunction.MDeterm(係数)
ここは実行時エラーが発生してしまいますから、間違っています。

On Error Resume Next ～ On Error Goto 0 で取ります。ただし、必ず、係数の行列式は、一旦、Empty を入れます。

回答No.2

Wendy02

>シートを介さずして逆行列の要素を、取得したい
例えばこういうことですか？ しかし、Inverse　Matrix の関数を使わないのでしたら、アルゴリズムを求めなくてはなりません。

Sub macMInverse1()
　Const N As Integer = 3　'マトリックスの1辺
　Const Data As String = "0.25,0.25,-0.75,0,0,0.5,0.75,-0.25,-0.25"　'データ

　Dim arData As Variant, buf As String, buf1 As String
　Dim i As Long, j As Long, k As Long
　Dim A(N - 1, N - 1)
　Dim B As Variant

　arData = Split(Data, ",")
　If UBound(arData) <> N * N - 1 Then MsgBox N & "×" & N & " のマトリックスになっていません。", 48: Exit Sub
　For i = 0 To N - 1
　　For j = 0 To N - 1
　　　A(i, j) = CDbl(arData(k))
　　　k = k + 1
　　Next
　Next
　B = WorksheetFunction.MInverse(A)
　For i = 1 To N
　　For j = 1 To N
　　　buf1 = buf1 & ", " & B(i, j)
　　Next
　　buf = buf & Mid(buf1, 2) & vbNewLine
　　buf1 = ""
　Next
　MsgBox buf
End Sub

お礼

ご回答ありがとうございます。

Inverse　Matrix の関数は使用しても問題ありません。

添付URLの

係数の逆行列 = WorksheetFunction.MInverse(係数)
Range("I2").Resize(r, r).Value = 係数の逆行列

の「係数」及び「係数の逆行列」がRANGEではないとだめなのかという趣旨でした。

ですので、「係数」へ行列の配列の格納方法が分かれば解決しそうです。

回答No.1

f272

そのサイトではVariant型の配列である「係数」にワークシートのセルの値をコピーして，その逆行列を求めているのですよ。ワークシートのセルの値をコピーすることは必須ではありません。まったく別のルーチンで配列「係数」の値を作っても，全く同じことができます。

お礼

ご回答ありがとうございます。

やはりそうですか！チャレンジしてみます。