vbaで、連立方程式を解く方法について

質問

掃き出し法を使って解くようですが、
-1 0 0 2 0 0 0
0 0 -1 -2 0 0 0
0 -2 0 0 -1 1 0
0 2 1 0 0 0 0
0 0 0 -2 0 -1 0
0 0 0 2 0 0 1

このように、行の入れ替えが必要な場合、繰り返しを用いて行を入れ替える必要がありますよね？
下のように作ってみましたが、上手くいきません。↑の行列を正しく入れ替えるだけならできるのですが、もう一度プログラムを作動させるとエラーが出ます。
For j = l To 6

If Abs(a(j, l)) >= Abs(max) Then'0と負の値しかない場合、0が最大になってしまう

u = j 'このときの行を保存
End If
Next j

For m = 1 To 7
brank = a(l, m) '入れ替える前の値を保存
a(l, m) = a(u, m)
a(u, m) = brank
Cells(l, m) = Cells(u, m)
Cells(u, m) = brank
Next m

Next l

do loopを使った方が良いと聞いたのですが、どのようにすればよいのでしょうか？

回答No.3

nag0720

＃１です。
プログラムを見ましたが、掃き出し法のアルゴリズムが間違ってます。

プログラムを見ると、
まず、行の入れ替えで対角上に最大の数値を移してから、そのあとに掃き出し法の計算で対角以外を０にしていますね。

この方法では、行の入れ替えで必ずしも対角上に０以外の数値がくるとは限りません。
実際、２回目の実行では、行の入れ替えをしてもCells(5,5)が０になっています。
これがエラーになる原因です。

正しい掃き出し法のアルゴリズムは、
行の入れ替えと行の計算を別々に行うのではなく、同じループの中で行います。

For n = 1 to 6
　（n列n行が最大数値になるようn+1行以降の行と入れ替える）
　（n列のn行を1に、n行以外が0になるように計算する）
Next n

回答No.2

layy

アルゴリズムを確認。サンプルも多数ある。

無駄なループはしてないか、判定なく入れ替えか、初期値は良いか、そんなところから。

１のときどう？、２のときどう？、トレース作業をすると見えてくる。

聞く前にもう一度見る。

回答No.1

nag0720

プログラムの一部だけ示されても、エラーの原因を特定するのは困難ですが、あえて想像するなら、

For j = l To 6
If Abs(a(j, l)) >= Abs(max) Then'0と負の値しかない場合、0が最大になってしまう
u = j 'このときの行を保存
End If
Next j

のところで、maxには何の値が入っているんでしょうか？
If文がすべてFLASEで、u = j が１回も実行されないとき、uには何の値が入っているんでしょうか？
もし、u = 0 なら　Cells(l, m) = Cells(u, m)　の箇所でエラーになります。

For m = 1 To 7
・・・・・
Next m
で列を入れ替えていますが、入れ替えするかどうかの判定が必要ではないですか？

do loopを使った方が良いかどうかは、全体の流れがわからないので何とも言えないです。

補足

Sub kadai2() ' 列の入れ替えを行う必要がある

Dim a(6, 7) As Double
Dim b(6) As Double
Dim max As Double
Dim f As Single
Dim j As Integer
Dim i As Integer
Dim l As Integer
Dim m As Integer
Dim n As Integer
Dim u As Integer
Dim w As Double
Dim brank As Double

For j = 1 To 6
For i = 1 To 7
a(j, i) = Cells(j, i)
Next i
b(j) = Cells(j, 7)
Next j

For l = 1 To 6

i = 1
max = 0
brank = 0

For j = l To 6 '入れ替えの時、iの値が変化していない、繰り返し

If Abs(a(j, l)) >= Abs(max) Then
max = a(j, l) '行の最大値が分かればよい,最大値を記録する必要無
u = j 'このときの行を保存
End If
Next j '繰り返し終わり

For m = 1 To 7
brank = a(l, m) '入れ替える前の値を保存
a(l, m) = a(u, m)
a(u, m) = brank
Cells(l, m) = Cells(u, m) '入れ替えは繰り返し終わった後 lの値が変化しないorz⇒入れ替えてるのはセルだけで、配列を入れ替えていない！
Cells(u, m) = brank '入れ替えは繰り返し終わった後
Next m

Next l

For j = 1 To 6
For i = 1 To 6
a(j, i) = Cells(j, i)
Next i
b(j) = Cells(j, 7)
Next j

For j = 1 To 6
For i = 1 To 6
If j <> i Then
a(j, i) = a(j, i) / a(j, j)

End If

Next i
b(j) = b(j) / a(j, j)
a(j, j) = 1
Cells(j + 7, j) = a(j, j)
For l = 1 To 6
If l <> j Then

w = a(l, j)

For i = 1 To 6 'j列同士の引き算

a(l, i) = a(l, i) - a(j, i) * w

Next i

b(l) = b(l) - b(j) * w 'wの値がおかしい　ここi で繰り返す意味ない。ここでbの値が全く変化していない！A.a(j,7)は存在しない: l =2のとき、b(1)が計算されない

End If
Next l
Next j

For j = 1 To 6
For i = 1 To 6
Cells(j + 7, i) = a(j, i)
Cells(j + 7, 7) = b(j)
Next i
Next j

End Sub