第６話 セル(1,2)のリスト構造解析のプログラム例
プログラム全文
Dim mah(8, 8) As Byte, lst(8, 8, 8) As Byte, mx(8, 8) As Byte, h(8, 8, 8) As Byte
Private Sub CommandButton1_Click()
Dim i As Byte, j As Byte
dainyuu
syokika
For i = 0 To 8
For j = 0 To 8
If mah(i, j) = 0 Then
Call cellkaiseki1(i, j)
Call cellkaiseki2(i, j)
End If
Next
Next
hyouji
End Sub
Sub dainyuu()
Dim i As Byte, j As Byte
For i = 0 To 8
For j = 0 To 8
If Cells(4 + i, 2 + j) = "" Then mah(i, j) = 0 Else mah(i, j) = Cells(4 + i, 2 + j)
Next
Next
End Sub
Sub hyouji()
Dim i As Byte, j As Byte, k As Byte
For i = 0 To 8
For j = 0 To 8
Cells(14 + i, 2 + j) = mah(i, j)
Next
Next
For i = 0 To 8
For j = 0 To 8
Cells(24 + 4 * i, 1 + 10 * j) = "セル"
Cells(24 + 4 * i, 2 + 10 * j) = i
Cells(24 + 4 * i, 3 + 10 * j) = j
Cells(24 + 4 * i, 4 + 10 * j) = "のリスト"
For k = 0 To 8
Cells(25 + 4 * i, 1 + 10 * j + k) = lst(i, j, k)
Next
Cells(26 + 4 * i, 1 + 10 * j) = "セル"
Cells(26 + 4 * i, 2 + 10 * j) = i
Cells(26 + 4 * i, 3 + 10 * j) = j
Cells(26 + 4 * i, 4 + 10 * j) = "のリスト数"
Cells(27 + 4 * i, 1 + 10 * j) = mx(i, j)
Next
Next
End Sub
Sub syokika()
Dim i As Byte, ja As Byte, k As Byte
For i = 0 To 8
For j = 0 To 8
For k = 0 To 8
h(i, j, k) = 1
lst(i, j, k) = k + 1
Next
Next
Next
End Sub
Sub cellkaiseki1(i As Byte, j As Byte)
Dim k As Byte, l As Byte
For k = 0 To 8
If mah(i, k) > 0 Then h(i, j, mah(i, k) - 1) = 0
Next
For k = 0 To 8
If mah(k, j) > 0 Then h(i, j, mah(k, j) - 1) = 0
Next
For k = 0 To 2
For l = 0 To 2
If 3 * Int(i / 3) + k <> i And 3 * Int(j / 3) + l <> j Then
If mah(3 * Int(i / 3) + k, 3 * Int(j / 3) + l) > 0 Then h(i, j, mah(3 * Int(i / 3) + k, 3 * Int(j / 3) + l) - 1) = 0
End If
Next
Next （2014/12/07訂正）
End Sub
Sub cellkaiseki2(i As Byte, j As Byte)
Dim k As Byte, w As Byte
w = 0
For k = 0 To 8
If h(i, j, k) = 1 Then
lst(i, j, w) = k + 1
w = w + 1
End If
Next
mx(i, j) = w
For k = 0 To 8
If h(i, j, k) = 0 Then
lst(i, j, w) = k + 1
w = w + 1
End If
Next
End Sub
Private Sub CommandButton2_Click()
Rows("14:200").Select
Selection.ClearContents
Range("M5", "V9").Select
Selection.ClearContents
Cells(2, 1).Select
End Sub
参考ファイル４
さて、次の課題はセルの構造解析をセル(1,2)のみではなく、
すべてのセルについて構造解析を出来るように改善することです。
当然、
Dim mah(8, 8) As Byte, lst(8) As Byte, mx As Byte, h(8) As Byte
は
Dim mah(8, 8) As Byte, lst(8, 8, 8) As Byte, mx(8, 8) As Byte, h(8, 8, 8) As Byte
と変更し、
Private Sub CommandButton1_Click()
dainyuu
syokika
cellkaiseki1
cellkaiseki2
hyouji
End Sub
は
Private Sub CommandButton1_Click()
Dim i As Byte, j As Byte
dainyuu
syokika
For i = 0 To 8
For j = 0 To 8
If mah(i, j) = 0 Then
Call cellkaiseki1(i, j)
Call cellkaiseki2(i, j)
Next
Next
Next
hyouji
End Sub
としなければなりません。
If mah(i, j) = 0 Thenは、
空欄のみを解析させるようにするために必要です。
また、その変更に伴って
Sub cellkaiseki1()
Sub cellkaiseki2()
のそれぞれは
Sub cellkaiseki1(i As byte, j As Byte)
Sub cellkaiseki2(i As byte, j As Byte)
に変えなければならないですし、
hyoujiのプログラムをいじらなければなりません。
実行画面
