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

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



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

'要素がすべて1
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

A 回答 (1件)

サイズ可変で作ってみました。

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

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
'行列のサイズは以下の2行で指定。長方形も可。
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 '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になるとあまりにも調べる数が多すぎるようですね。
    • good
    • 0
この回答へのお礼

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

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

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

お礼日時:2012/10/18 13:49

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