プロが教える店舗&オフィスのセキュリティ対策術

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.h …


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

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

A 回答 (3件)

>「係数」及び「係数の逆行列」が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 を入れます。
    • good
    • 0

>シートを介さずして逆行列の要素を、取得したい


例えばこういうことですか? しかし、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
    • good
    • 0
この回答へのお礼

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

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


添付URLの

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

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

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

お礼日時:2010/07/09 21:49

そのサイトではVariant型の配列である「係数」にワークシートのセルの値をコピーして,その逆行列を求めているのですよ。

ワークシートのセルの値をコピーすることは必須ではありません。まったく別のルーチンで配列「係数」の値を作っても,全く同じことができます。
    • good
    • 0
この回答へのお礼

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

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

お礼日時:2010/07/09 21:44

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!