Dim a(200) As Byte
Dim iz(80) As Byte, jz(80) As Byte, zrbsy(80) As Byte, bsy As Byte, kkr(80) As Byte
Dim mah(8, 8) As Byte, hs As Byte, lst(8, 8, 8) As Byte, rlst(8, 8, 8) As Byte, cnn(8, 8) As Byte, h1(80, 8) As Byte, h2(80, 8) As Byte, h3(80, 2, 2) As Byte
Dim hh1(80, 8) As Byte, hh2(80, 8) As Byte, hh3(80, 2, 2) As Byte
Dim cn As Byte
Dim kaisuu As Byte
Dim hintosuu As Byte
Dim kuuransuu As Byte
Dim hsk(200) As Byte
Dim kth As Byte
Dim sgh As Byte
Dim csk(8, 8, 8) As Byte
Dim shkt As Integer
Dim hskuuransuu(200) As Byte
Dim hsshkt(200) As Byte
Dim hj As Date, ow As Date
Private Sub CommandButton1_Click()
CommandButton2_Click
Dim hnt As Byte
hnt = Cells(5, 13)
If hnt > 36 Or hnt < 22 Then
Cells(8, 12) = "入力が正しくありません。"
GoTo tobi
End If
hj = Timer
Dim sg As Integer
Dim a(200) As Byte, i As Byte
Set ws = CreateObject("WScript.Shell")
ws.CurrentDirectory = "c:\sudoku-ver1\"
Select Case hnt
Case 40
ws.Run """40.exe""", 1, True
Case 39
ws.Run """39.exe""", 1, True
Case 38
ws.Run """38.exe""", 1, True
Case 37
ws.Run """37.exe""", 1, True
Case 36
ws.Run """36.exe""", 1, True
Case 35
ws.Run """35.exe""", 1, True
Case 34
ws.Run """34.exe""", 1, True
Case 33
ws.Run """33.exe""", 1, True
Case 32
ws.Run """32.exe""", 1, True
Case 31
ws.Run """31.exe""", 1, True
Case 30
ws.Run """30.exe""", 1, True
Case 29
ws.Run """29.exe""", 1, True
Case 28
ws.Run """28.exe""", 1, True
Case 27
ws.Run """27.exe""", 1, True
Case 26
ws.Run """26.exe""", 1, True
Case 25
ws.Run """25.exe""", 1, True
Case 24
ws.Run """24.exe""", 1, True
Case 23
ws.Run """23.exe""", 1, True
Case 22
ws.Run """22.exe""", 1, True
End Select
Dim buf As String
Open "C:\sudoku-ver1\a.csv" For Input As #1
Dim w As Byte
w = 0
Do Until EOF(1)
Line Input #1, buf
a(w) = CByte(buf)
w = w + 1
Loop
Close #1
Dim k As Byte
Kk = 0
For i = 0 To 80
If a(i) > 0 Then
Cells(3 + Int(i / 9), 2 + (i Mod 9)) = a(i)
Cells(13 + Int(i / 9), 2 + (i Mod 9)) = a(i)
Cells(23 + Int(i / 9), 2 + (i Mod 9)) = a(i)
k = k + 1
End If
Next
Cells(11, 12) = k
For i = 81 To 161
Cells(33 + Int((i - 81) / 9), 2 + ((i - 81) Mod 9)) = a(i)
Next
3,CommandButton3_Click
tobi:
End Sub
Private Sub CommandButton2_Click()
Range("R6:R10").Select
Selection.ClearContents
Range("B3:J11").Select
Selection.ClearContents
Range("B13:J21").Select
Selection.ClearContents
Range("B23:J31").Select
Selection.ClearContents
Range("B33:J41").Select
Selection.ClearContents
Range("L6:L10").Select
Selection.ClearContents
Range("A2").Select
End Sub
Private Sub CommandButton3_Click()
Range("R6:R10").Select
Selection.ClearContents
Dim i As Byte
Dim j As Byte
Dim h As Byte
Worksheets("Sheet1").Cells(3, 1).Select
ktcn = 0
h = 1
syokika1
dainyuu1
kuu
For i = 0 To 9
cellskaiseki
If cn = 1 Then Exit For
Next
If cn = 1 Then hyouji
If cn = 0 Then
h = 0
kisokaiseki
sakusei (0)
End If
If h = 1 Then
Cells(6, 18) = "理詰め(確定法)のみで解けました。"
//Cells(3, 12) = Cells(3, 12) + 1
Else
CommandButton1_Click
End If
ow = Timer
Cells(7, 18) = "数独作成にかかった時間は"
Cells(8, 18) = ow - hj
Cells(9, 18) = "秒です。"
End Sub
Sub syokika1()
Dim i As Byte, j As Byte, k As Byte, l As Byte
cn = 0
kth = 0
shkt = 0
For i = 0 To 8
For j = 0 To 8
mah(i, j) = 0
cnn(i, j) = 0
Next
Next
For i = 0 To 8
For j = 0 To 8
For k = 0 To 8
csk(i, j, k) = 0
Next
Next
Next
End Sub
Sub dainyuu1()
Dim i As Byte, j As Byte, s As Byte, a As Byte, k1 As Byte, k2 As Byte, k3 As Byte, k4 As Byte, k As Byte, l As Byte
s = Int(kaisuu / 25)
a = kaisuu Mod 25
For i = 0 To 8
For j = 0 To 8
If Cells(3 + i, 2 + j) > 0 Then
mah(i, j) = Cells(3 + i, 2 + j)
For k = 0 To 8
If mah(k, j) = 0 Then
csk(mah(i, j) - 1, k, j) = 1
End If
If mah(i, k) = 0 Then
csk(mah(i, j) - 1, i, k) = 1
End If
If mah(3 * Int(i / 3) + Int(k / 3), 3 * Int(j / 3) + (k Mod 3)) = 0 Then
csk(mah(i, j) - 1, 3 * Int(i / 3) + Int(k / 3), 3 * Int(j / 3) + (k Mod 3)) = 1
End If
Next
mah(i, j) = 0
End If
Next
Next
End Sub
Sub kuu()
Dim i As Byte, j As Byte
kuuransuu = 0
For i = 0 To 8
For j = 0 To 8
If mah(i, j) = 0 Then kuuransuu = kuuransuu + 1
Next
Next
End Sub
Sub cellskaiseki()
Dim i As Byte, j As Byte, k As Byte, x As Byte, y As Byte, cs As Byte, l As Byte, m As Byte, gk(8) As Byte, rk(8) As Byte
Dim h As Byte, c1 As Byte, o As Byte, p As Byte, n As Byte, w As Byte, gk2(8) As Byte, rk2(8) As Byte, c As Byte
Dim gk3(8) As Byte, rk3(8) As Byte
For i = 0 To 8
For j = 0 To 2
For k = 0 To 2
cs = 0
For l = 0 To 2
For m = 0 To 2
If mah(3 * j + l, 3 * k + m) = 0 Then
If csk(i, 3 * j + l, 3 * k + m) = 0 Then
gk(cs) = 3 * j + l
rk(cs) = 3 * k + m
cs = cs + 1
End If
End If
Next
Next
If cs = 1 Then
mah(gk(0), rk(0)) = i + 1
kuuransuu = kuuransuu - 1
If kuuransuu = 0 Then
cn = 1
Exit Sub
End If
For l = 0 To 8
If mah(l, rk(0)) = 0 Then
csk(i, l, rk(0)) = 1
End If
If mah(gk(0), l) = 0 Then
csk(i, gk(0), l) = 1
End If
If mah(3 * Int(gk(0) / 3) + Int(l / 3), 3 * Int(rk(0) / 3) + (l Mod 3)) = 0 Then
csk(i, 3 * Int(gk(0) / 3) + Int(l / 3), 3 * Int(rk(0) / 3) + (l Mod 3)) = 1
End If
Next
End If
If cs = 2 Then
If gk(0) = gk(1) Then
For l = 0 To 8
If Int(l / 3) <> Int(rk(0) / 3) Then
If mah(gk(0), l) = 0 Then
csk(i, gk(0), l) = 1
End If
End If
Next
For l = i + 1 To 8
c1 = 0
For m = 0 To 2
For n = 0 To 2
If mah(3 * j + m, 3 * k + n) = 0 Then
If csk(l, 3 * j + m, 3 * k + n) = 0 Then
gk2(c1) = 3 * j + m
rk2(c1) = 3 * k + n
c1 = c1 + 1
End If
End If
Next
Next
If c1 = 1 Then
mah(gk2(0), rk2(0)) = l + 1
kuuransuu = kuuransuu - 1
If kuuransuu = 0 Then
cn = 1
Exit Sub
End If
For m = 0 To 8
If mah(m, rk2(0)) = 0 Then
csk(l, m, rk2(0)) = 1
End If
If mah(gk2(0), m) = 0 Then
csk(l, gk2(0), m) = 1
End If
If mah(3 * Int(gk2(0) / 3) + Int(m / 3), 3 * Int(rk2(0) / 3) + (m Mod 3)) = 0 Then
csk(l, 3 * Int(gk2(0) / 3) + Int(m / 3), 3 * Int(rk2(0) / 3) + (m Mod 3)) = 1
End If
Next
End If
If c1 = 2 Then
If gk(0) = gk2(0) And gk(1) = gk2(1) And rk(0) = rk2(0) And rk(1) = rk2(1) Then
For m = 0 To 8
If m <> i And m <> l Then
csk(m, gk(0), rk(0)) = 1
csk(m, gk(0), rk(1)) = 1
End If
Next
For m = 0 To 8
If Int(m / 3) <> Int(rk(0) / 3) Then
csk(l, gk(0), m) = 1
End If
Next
End If
End If
Next
End If
If rk(0) = rk(1) Then
For l = 0 To 8
If Int(l / 3) <> Int(gk(0) / 3) Then
If mah(l, rk(0)) = 0 Then
csk(i, l, rk(0)) = 1
End If
End If
Next
For l = i + 1 To 8
c1 = 0
For m = 0 To 2
For n = 0 To 2
If mah(3 * j + m, 3 * k + n) = 0 Then
If csk(l, 3 * j + m, 3 * k + n) = 0 Then
gk2(c1) = 3 * j + m
rk2(c1) = 3 * k + n
c1 = c1 + 1
End If
End If
Next
Next
If c1 = 1 Then
mah(gk2(0), rk2(0)) = l + 1
kuuransuu = kuuransuu - 1
If kuuransuu = 0 Then
cn = 1
Exit Sub
End If
For m = 0 To 8
If mah(m, rk2(0)) = 0 Then
csk(l, m, rk2(0)) = 1
End If
If mah(gk2(0), m) = 0 Then
csk(l, gk2(0), m) = 1
End If
If mah(3 * Int(gk2(0) / 3) + Int(m / 3), 3 * Int(rk2(0) / 3) + (m Mod 3)) = 0 Then
csk(l, 3 * Int(gk2(0) / 3) + Int(m / 3), 3 * Int(rk2(0) / 3) + (m Mod 3)) = 1
End If
Next
End If
If c1 = 2 Then
If gk(0) = gk2(0) And gk(1) = gk2(1) And rk(0) = rk2(0) And rk(1) = rk2(1) Then
For m = 0 To 8
If m <> i And m <> l Then
csk(m, gk(0), rk(0)) = 1
csk(m, gk(1), rk(0)) = 1
End If
Next
For m = 0 To 8
If Int(m / 3) <> Int(gk(0) / 3) Then
csk(l, m, rk(0)) = 1
End If
Next
End If
End If
Next
End If
End If
If cs = 3 Then
If gk(0) = gk(1) And gk(1) = gk(2) Then
For l = 0 To 8
If Int(l / 3) <> Int(rk(0) / 3) Then
If mah(gk(0), l) = 0 Then
csk(i, gk(0), l) = 1
End If
End If
Next
End If
If rk(0) = rk(1) And rk(1) = rk(2) Then
For l = 0 To 8
If Int(l / 3) <> Int(gk(0) / 3) Then
If mah(l, rk(0)) = 0 Then
csk(i, l, rk(0)) = 1
End If
End If
Next
End If
End If
Next
Next
For j = 0 To 8
cs = 0
For k = 0 To 8
If mah(j, k) = 0 Then
If csk(i, j, k) = 0 Then
rk(cs) = k
cs = cs + 1
End If
End If
Next
If cs = 1 Then
mah(j, rk(0)) = i + 1
kuuransuu = kuuransuu - 1
If kuuransuu = 0 Then
cn = 1
Exit Sub
End If
For k = 0 To 8
If mah(k, rk(0)) = 0 Then
csk(i, k, rk(0)) = 1
End If
If mah(j, k) = 0 Then
csk(i, j, k) = 1
End If
If mah(3 * Int(j / 3) + Int(k / 3), 3 * Int(rk(0) / 3) + (k Mod 3)) = 0 Then
csk(i, 3 * Int(j / 3) + Int(k / 3), 3 * Int(rk(0) / 3) + (k Mod 3)) = 1
End If
Next
End If
If cs = 2 Then
If Int(rk(0) / 3) = Int(rk(1) / 3) Then
For k = 0 To 8
If (j Mod 3) <> Int(k / 3) Then
If mah(3 * Int(j / 3) + Int(k / 3), 3 * Int(rk(0) / 3) + (k Mod 3)) = 0 Then
csk(i, 3 * Int(j / 3) + Int(k / 3), 3 * Int(rk(0) / 3) + (k Mod 3)) = 1
End If
End If
Next
End If
For l = i + 1 To 8
c1 = 0
For m = 0 To 8
If mah(j, m) = 0 Then
If csk(l, j, m) = 0 Then
rk2(c1) = m
c1 = c1 + 1
End If
End If
Next
If c1 = 1 Then
mah(j, rk2(0)) = l + 1
kuuransuu = kuuransuu - 1
If kuuransuu = 0 Then
cn = 1
Exit Sub
End If
For m = 0 To 8
If mah(m, rk2(0)) = 0 Then
csk(l, m, rk2(0)) = 1
End If
If mah(j, m) = 0 Then
csk(l, j, m) = 1
End If
If mah(3 * Int(j / 3) + Int(m / 3), 3 * Int(rk2(0) / 3) + (m Mod 3)) = 0 Then
csk(l, 3 * Int(j / 3) + Int(m / 3), 3 * Int(rk2(0) / 3) + (m Mod 3)) = 1
End If
Next
End If
If c1 = 2 Then
If rk(0) = rk2(0) And rk(1) = rk2(1) Then
For m = 0 To 8
If m <> i And m <> l Then
csk(m, j, rk(0)) = 1
csk(m, j, rk(1)) = 1
End If
Next
End If
End If
Next
For k = 0 To 8
If k <> j Then
c1 = 0
For l = 0 To 8
If mah(k, l) = 0 Then
If csk(i, k, l) = 0 Then
rk3(c1) = l
c1 = c1 + 1
End If
End If
Next
If c1 = 2 Then
If rk(0) = rk3(0) And rk(1) = rk3(1) Then
For l = 0 To 8
If l <> j And l <> k Then
If mah(l, rk(0)) = 0 Then
csk(i, l, rk(0)) = 1
End If
If mah(l, rk(1)) = 0 Then
csk(i, l, rk(1)) = 1
End If
End If
Next
Exit For
End If
End If
End If
Next
End If
Next
For j = 0 To 8
cs = 0
For k = 0 To 8
If mah(k, j) = 0 Then
If csk(i, k, j) = 0 Then
gk(cs) = k
cs = cs + 1
End If
End If
Next
If cs = 1 Then
mah(gk(0), j) = i + 1
kuuransuu = kuuransuu - 1
If kuuransuu = 0 Then
cn = 1
Exit Sub
End If
For k = 0 To 8
If mah(gk(0), k) = 0 Then
csk(i, gk(0), k) = 1
End If
If mah(k, j) = 0 Then
csk(i, k, j) = 1
End If
If mah(3 * Int(gk(0) / 3) + Int(k / 3), 3 * Int(j / 3) + (k Mod 3)) = 0 Then
csk(i, 3 * Int(gk(0) / 3) + Int(k / 3), 3 * Int(j / 3) + (k Mod 3)) = 1
End If
Next
End If
If cs = 2 Then
If Int(gk(0) / 3) = Int(gk(1) / 3) Then
For k = 0 To 8
If (j Mod 3) <> Int(k / 3) Then
If mah(3 * Int(gk(0) / 3) + (k Mod 3), 3 * Int(j / 3) + Int(k / 3)) = 0 Then
csk(i, 3 * Int(gk(0) / 3) + (k Mod 3), 3 * Int(j / 3) + Int(k / 3)) = 1
End If
End If
Next
End If
For l = i + 1 To 8
c1 = 0
For m = 0 To 8
If mah(m, j) = 0 Then
If csk(l, m, j) = 0 Then
gk2(c1) = m
c1 = c1 + 1
End If
End If
Next
If c1 = 1 Then
mah(gk2(0), j) = l + 1
kuuransuu = kuuransuu - 1
If kuuransuu = 0 Then
cn = 1
Exit Sub
End If
For m = 0 To 8
If mah(gk2(0), m) = 0 Then
csk(l, gk2(0), m) = 1
End If
If mah(m, j) = 0 Then
csk(l, m, j) = 1
End If
If mah(3 * Int(gk2(0) / 3) + Int(m / 3), 3 * Int(j / 3) + (m Mod 3)) = 0 Then
csk(l, 3 * Int(gk2(0) / 3) + Int(m / 3), 3 * Int(j / 3) + (m Mod 3)) = 1
End If
Next
End If
If c1 = 2 Then
If gk(0) = gk2(0) And gk(1) = gk2(1) Then
For m = 0 To 8
If m <> i And m <> l Then
csk(m, gk(0), j) = 1
csk(m, gk(1), j) = 1
End If
Next
End If
End If
Next
For k = 0 To 8
If k <> j Then
c1 = 0
For l = 0 To 8
If mah(l, k) = 0 Then
If csk(i, l, k) = 0 Then
gk3(c1) = l
c1 = c1 + 1
End If
End If
Next
If c1 = 2 Then
If gk(0) = gk3(0) And gk(1) = gk3(1) Then
For l = 0 To 8
If l <> j And l <> k Then
If mah(gk(0), l) = 0 Then
csk(i, gk(0), l) = 1
End If
If mah(gk(1), l) = 0 Then
csk(i, gk(1), l) = 1
End If
End If
Next
Exit For
End If
End If
End If
Next
End If
Next
Next
For i = 0 To 8
For j = 0 To 8
If mah(i, j) = 0 Then
kyokusyokaiseki i, j
If cnn(i, j) = 1 Then
mah(i, j) = rlst(i, j, 0)
kuuransuu = kuuransuu - 1
If kuuransuu = 0 Then
cn = 1
Exit Sub
End If
For k = 0 To 8
If mah(k, j) = 0 Then
csk(rlst(i, j, 0) - 1, k, j) = 1
End If
If mah(i, k) = 0 Then
csk(rlst(i, j, 0) - 1, i, k) = 1
End If
If mah(3 * Int(i / 3) + Int(k / 3), 3 * Int(j / 3) + (k Mod 3)) = 0 Then
csk(rlst(i, j, 0) - 1, 3 * Int(i / 3) + Int(k / 3), 3 * Int(j / 3) + (k Mod 3)) = 1
End If
Next
End If
If cnn(i, j) = 2 Then
For k = 0 To 8
If k <> i Then
If mah(k, j) = 0 Then
kyokusyokaiseki k, j
If cnn(k, j) = 2 Then
If rlst(i, j, 0) = rlst(k, j, 0) And rlst(i, j, 1) = rlst(k, j, 1) Then
For l = 0 To 8
If l <> i And l <> k Then
csk(rlst(i, j, 0) - 1, l, j) = 1
csk(rlst(i, j, 1) - 1, l, j) = 1
End If
Next
End If
End If
End If
End If
If k <> j Then
If mah(i, k) = 0 Then
kyokusyokaiseki i, k
If cnn(i, k) = 2 Then
If rlst(i, j, 0) = rlst(i, k, 0) And rlst(i, j, 1) = rlst(i, k, 1) Then
For l = 0 To 8
If l <> j And l <> k Then
csk(rlst(i, j, 0) - 1, i, l) = 1
csk(rlst(i, j, 1) - 1, i, l) = 1
End If
Next
End If
End If
End If
End If
Next
End If
End If
Next
Next
End Sub
Sub kyokusyokaiseki(y As Byte, x As Byte)
Dim i As Byte, j As Byte, w As Byte
w = 0
For i = 0 To 8
rlst(y, x, i) = 0
Next
For i = 0 To 8
If csk(i, y, x) = 0 Then
rlst(y, x, w) = i + 1
w = w + 1
End If
Next
cnn(y, x) = w
End Sub
Sub kisokaiseki()
Dim i As Byte, j As Byte
hs = 0
For i = 0 To 8
For j = 0 To 8
If mah(i, j) = 0 Then
zrbsy(hs) = 9 * i + j
hs = hs + 1
End If
Next
Next
If hs = 0 Then Exit Sub
bsy = hs - 1
totalkaiseki
bangousakusei (0)
End Sub
Sub totalkaiseki()
Dim i1 As Byte, i2 As Byte, i3 As Byte, i4 As Byte, i As Byte
If cn = 1 Then Exit Sub
For i = 0 To hs - 1
i1 = Int(zrbsy(i) / 9)
i2 = zrbsy(i) Mod 9
cnn(i1, i2) = 0
Next
For i = 0 To hs - 1
i1 = Int(zrbsy(i) / 9)
i2 = zrbsy(i) Mod 9
For i3 = 0 To 8
lst(i1, i2, i3) = 0
Next
For i3 = 0 To 8
If i2 <> i3 And mah(i1, i3) > 0 Then lst(i1, i2, mah(i1, i3) - 1) = 1
Next
For i3 = 0 To 8
If i1 <> i3 And mah(i3, i2) > 0 Then lst(i1, i2, mah(i3, i2) - 1) = 1
Next
i1s = Int(i1 / 3)
i2s = Int(i2 / 3)
For i3 = 0 To 2
For i4 = 0 To 2
If 3 * i1s + i3 <> i1 And 3 * i2s + i4 <> i2 And mah(3 * i1s + i3, 3 * i2s + i4) > 0 Then lst(i1, i2, mah(3 * i1s + i3, 3 * i2s + i4) - 1) = 1
Next
Next
For i3 = 0 To 8
If lst(i1, i2, i3) = 0 Then
w = cnn(i1, i2)
rlst(i1, i2, w) = i3 + 1
cnn(i1, i2) = cnn(i1, i2) + 1
End If
Next
Next
End Sub
Sub subkaiseki(g As Byte)
Dim i As Byte, j As Byte
y = iz(g)
x = jz(g)
ys = Int(y / 3)
xs = Int(x / 3)
For i = 0 To 8
If mah(y, i) = 0 Then
h1(g, i) = 0
hh1(g, i) = 0
If lst(y, i, mah(y, x) - 1) = 0 Then
lst(y, i, mah(y, x) - 1) = 1
cnn(y, i) = cnn(y, i) - 1
If cnn(y, i) > 0 Then
For j = 0 To cnn(y, i) - 1
If rlst(y, i, j) = mah(y, x) Then
For k = j To cnn(y, i) - 1
rlst(y, i, k) = rlst(y, i, k + 1)
Next
rlst(y, i, cnn(y, i)) = mah(y, x)
hh1(g, i) = j
Exit For
End If
Next
End If
h1(g, i) = 1
End If
End If
If mah(i, x) = 0 Then
h2(g, i) = 0
hh2(g, i) = 0
If lst(i, x, mah(y, x) - 1) = 0 Then
lst(i, x, mah(y, x) - 1) = 1
cnn(i, x) = cnn(i, x) - 1
If cnn(i, x) > 0 Then
For j = 0 To cnn(i, x) - 1
If rlst(i, x, j) = mah(y, x) Then
For k = j To cnn(i, x) - 1
rlst(i, x, k) = rlst(i, x, k + 1)
Next
rlst(i, x, cnn(i, x)) = mah(y, x)
hh2(g, i) = j
Exit For
End If
Next
End If
h2(g, i) = 1
End If
End If
Next
For i = 0 To 2
For j = 0 To 2
If 3 * ys + i <> y And 3 * xs + j <> x And mah(3 * ys + i, 3 * xs + j) = 0 Then
h3(g, i, j) = 0
hh3(g, i, j) = 0
If lst(3 * ys + i, 3 * xs + j, mah(y, x) - 1) = 0 Then
lst(3 * ys + i, 3 * xs + j, mah(y, x) - 1) = 1
cnn(3 * ys + i, 3 * xs + j) = cnn(3 * ys + i, 3 * xs + j) - 1
For k = 0 To cnn(3 * ys + i, 3 * xs + j) - 1
If rlst(3 * ys + i, 3 * xs + j, k) = mah(y, x) Then
For l = k To cnn(3 * ys + i, 3 * xs + j) - 1
rlst(3 * ys + i, 3 * xs + j, l) = rlst(3 * ys + i, 3 * xs + j, l + 1)
Next
rlst(3 * ys + i, 3 * xs + j, cnn(3 * ys + i, 3 * xs + j)) = mah(y, x)
hh3(g, i, j) = k
Exit For
End If
Next
h3(g, i, j) = 1
End If
End If
Next
Next
End Sub
Sub gyakusubkaiseki(g As Byte)
Dim i As Byte
Dim j As Byte
If mnds = 1 And cn = 1 Then Exit Sub
If mnds = 0 And cn = 2 Then Exit Sub
y = iz(g)
x = jz(g)
ys = Int(y / 3)
xs = Int(x / 3)
For i = 0 To 8
If mah(y, i) = 0 Then
If h1(g, i) = 1 Then
lst(y, i, mah(y, x) - 1) = 0
cnn(y, i) = cnn(y, i) + 1
If cnn(y, i) = 2 Then chs = chs - 1
w = rlst(y, i, hh1(g, i))
rlst(y, i, hh1(g, i)) = mah(y, x)
rlst(y, i, cnn(y, i) - 1) = w
End If
End If
If mah(i, x) = 0 Then
If h2(g, i) = 1 Then
lst(i, x, mah(y, x) - 1) = 0
cnn(i, x) = cnn(i, x) + 1
If cnn(i, x) = 2 Then chs = chs - 1
w = rlst(i, x, hh2(g, i))
rlst(i, x, hh2(g, i)) = mah(y, x)
rlst(i, x, cnn(i, x) - 1) = w
End If
End If
Next
For i = 0 To 2
For j = 0 To 2
If 3 * ys + i <> y And 3 * xs + j <> x And mah(3 * ys + i, 3 * xs + j) = 0 Then
If h3(g, i, j) = 1 Then
lst(3 * ys + i, 3 * xs + j, mah(y, x) - 1) = 0
cnn(3 * ys + i, 3 * xs + j) = cnn(3 * ys + i, 3 * xs + j) + 1
If cnn(3 * ys + i, 3 * xs + j) = 2 Then chs = chs - 1
w = rlst(3 * ys + i, 3 * xs + j, hh3(g, i, j))
rlst(3 * ys + i, 3 * xs + j, hh3(g, i, j)) = mah(y, x)
rlst(3 * ys + i, 3 * xs + j, cnn(3 * ys + i, 3 * xs + j) - 1) = w
End If
End If
Next
Next
End Sub
Sub bangousakusei(g As Byte)
Dim i As Byte, j As Byte, k As Byte
If cn = 1 Then Exit Sub
Min = 9
For k = 0 To bsy - g
i = Int(zrbsy(k) / 9)
j = zrbsy(k) Mod 9
If cnn(i, j) < Min Then
Min = cnn(i, j)
imin = i
jmin = j
kkr(g) = k
End If
Next
iz(g) = imin
jz(g) = jmin
w = zrbsy(bsy - g)
zrbsy(bsy - g) = zrbsy(kkr(g))
zrbsy(kkr(g)) = w
End Sub
Sub gyakubangousakusei(g As Byte)
If cn = 1 Then Exit Sub
w = zrbsy(bsy - g)
zrbsy(bsy - g) = zrbsy(kkr(g))
zrbsy(kkr(g)) = w
End Sub
Sub sakusei(g As Byte)
Dim i As Byte, j As Byte, k As Byte
If cn = 1 Then Exit Sub
j = jz(g)
i = iz(g)
mx = cnn(i, j)
For k = 1 To mx
mah(i, j) = rlst(i, j, k - 1)
If g + 1 < hs Then
subkaiseki (g)
bangousakusei (g + 1)
sakusei (g + 1)
If cn = 1 Then Exit Sub
gyakusubkaiseki (g)
gyakubangousakusei (g + 1)
Else
cn = 1
hyouji
Exit Sub
End If
Next
mah(i, j) = 0
End Sub
Sub hyouji()
Dim i As Byte, j As Byte
For i = 0 To 8
For j = 0 To 8
' Cells(i + 14, j + 2) = mah(i, j)
' If Cells(14 + i, 2 + j) <> "*" Then If mah(i, j) > 0 Then Cells(14 + i, 2 + j) = mah(i, j) Else Cells(14 + i, 2 + j) = ""
If mah(i, j) > 0 Then Cells(33 + i, 2 + j) = mah(i, j) Else Cells(33 + i, 2 + j) = ""
Next
Next
End Sub
Private Sub CommandButton4_Click()
Cells(3, 12) = 0
Cells(4, 12) = 0
CommandButton2_Click
End Sub