VBAで行列を作る方法

質問

次のようなプログラミングで１，０，－１の要素で作られる3×3行列を全通り調べています。
この場合３の９乗通り調べることができます。
これを4×4や５×５行列など数を大きくして調べたいのですが、このプログラムを配列を使うなどして
簡単にできる方法を教えてください。
よろしくおねがいします。

Sub test()

Dim a As Integer '行
Dim b As Integer '列

Dim c As Integer, i As Integer, j As Integer, d As Integer, e As Integer
Dim 内積 As Integer, step As Integer
Dim f As Integer, g As Integer, h As Integer, l As Integer, m As Integer, n As Integer, k As Integer, x As Integer
Dim sum As Integer, total As Integer
Dim aa As Integer, aaa As Integer, aaaa As Integer, bb As Integer, bbb As Integer, bbbb As Integer

a = 3 '行
b = 3 '列

c = 0
内積 = 0
con = 0
sum = 0
tatal = 0
aa = 0
aaa = 0
aaaa = 0
bb = 0
bbb = 0
bbbb = 0
x = 0

For n = 0 To 2
For m = 0 To 2
For l = 0 To 2
For k = 0 To 2
For h = 0 To 2
For g = 0 To 2
For f = 0 To 2
For e = 0 To 2
For d = 0 To 2

'要素がすべて１
For i = 1 To a
For j = 1 To b
Cells(i, j) = 1

Next j
Next i

If bbbb = 1 Then
Cells(a - 2, b - 2) = 0
ElseIf bbbb = 2 Then
Cells(a - 2, b - 2) = -1
End If

If bbb = 1 Then
Cells(a - 1, b - 2) = 0
ElseIf bbb = 2 Then
Cells(a - 1, b - 2) = -1
End If

If bb = 1 Then
Cells(a, b - 2) = 0
ElseIf bb = 2 Then
Cells(a, b - 2) = -1
End If

If aaaa = 1 Then
Cells(a - 2, b - 1) = 0
ElseIf aaaa = 2 Then
Cells(a - 2, b - 1) = -1
End If

If aaa = 1 Then
Cells(a - 1, b - 1) = 0
ElseIf aaa = 2 Then
Cells(a - 1, b - 1) = -1
End If

If aa = 1 Then
Cells(a, b - 1) = 0
ElseIf aa = 2 Then
Cells(a, b - 1) = -1
End If

If total = 1 Then
Cells(a - 2, b) = 0
ElseIf total = 2 Then
Cells(a - 2, b) = -1
End If

If sum = 1 Then
Cells(a - 1, b) = 0
ElseIf sum = 2 Then
Cells(a - 1, b) = -1
End If

If con = 1 Then
Cells(a, b) = 0
ElseIf con = 2 Then
Cells(a, b) = -1
End If

con = con + 1
Next d
con = 0
sum = sum + 1
Next e
sum = 0
total = total + 1
Next f
total = 0
aa = aa + 1
Next g
aa= 0
aaa = aaa + 1
Next h
aaa = 0
aaaa = aaaa + 1
Next k
aaaa = 0
bb = bb + 1
Next l
bb = 0
bbb = bbb + 1
Next m
bbb = 0
bbbb = bbbb + 1
Next n

End Sub

回答No.1

queuerev2 · ベストアンサー

サイズ可変で作ってみました。速度も重視したつもりです。
「内積」などの変数は入っていませんので、必要に応じて質問者様の方で補ってください。

Sub test2()
Dim ary1() As Integer
Dim a As Integer, b As Integer
Dim i As Integer, j As Integer
Dim endf As Boolean

endf = False
'行列のサイズは以下の２行で指定。長方形も可。
a = 3 '行
b = 3 '列
ReDim ary1(1 To a, 1 To b)

'行列の初期化。すべて -1 にする。
For i = 1 To a
For j = 1 To b
ary1(i, j) = -1
Next j
Next i

'メインループ
Do

'行列を使って何か処理するならここで

' Range(Cells(1, 1), Cells(a, b)) = ary1
'ワークシートに書き込むなら↑これでよいが毎回書き込むと遅い

'行列データの更新と終了判定
i = a
j = b
Do
If ary1(i, j) < 1 Then '要素の値が -1 か 0 ならば
ary1(i, j) = ary1(i, j) + 1 '1 増やして更新終了。
Exit Do '実際のメインループ終了判定へ行き続行(endf = False)。
Else '要素の値が 1 ならば
ary1(i, j) = -1 '-1 に戻して
i = i - 1 '繰り上がり処理。まずは1行上へ。
If i = 0 Then '上にはみ出したら
i = a '最下行に戻り
j = j - 1 '１つ左の列へ。
If j = 0 Then '左にはみ出したら
endf = True 'メインループ終了決定。
Exit Do '実際のメインループ終了判定へ。
End If
End If
End If
Loop '行列の次の要素を更新する（繰り上がって更新続行）
Loop Until endf '実際のメインループ終了判定
End Sub

以上です。

しかし4×4まではよいとしても、5×5はかなり時間がかかりそうです。
C言語などの速い言語で書き直すことが出来るならそのほうがよいかもしれません。
さらに、6×6になるとあまりにも調べる数が多すぎるようですね。

お礼

お返事ありがとうございます。

実行してみたところ速度もかなり早くなり、行列を拡張していっても実行することができました。
プログラミングの解説もありとてもわかりやすかったです。
やはり6×6になると時間もかかってしまいますよね。
ずっと悩んでいたので簡単にしていただき感動しています。

本当にありがとうございました！！