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(250) As Byte
Dim hsshkt(200) As Byte
Dim hj As Date, ow As Date
Dim sng As Byte
Private Sub CommandButton1_Click()
Range("Z3,AD3,V9,X9").Select
Selection.ClearContents
sng = 1
Dim hnt As Byte
hnt = Cells(5, 13)
If hnt > 30 Or hnt < 20 Then
Cells(8, 12) = "入力が正しくありません。"
GoTo tobi
End If
hj = Timer
Dim s As Integer
Dim 最後 As Integer
最後 = 100
Cells(3, 30) = "%"
Dim i As Byte
Set ws = CreateObject("WScript.Shell")
ws.CurrentDirectory = "c:\newsudoku\"
Range("Z4:AI13").Select
Selection.ClearContents
For s = 0 To 最後 - 1
CommandButton2_Click
Select Case hnt
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
Case 21
ws.Run """21.exe""", 1, True
Case 20
ws.Run """20.exe""", 1, True
End Select
Dim buf As String
Open "C:\newsudoku\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
k = 0
For i = 0 To 80
If a(i) > 0 Then
Cells(3 + Int(i / 9), 2 + (i Mod 9)) = a(i)
Sheet2.Cells(2 + Int(i / 9) + 20 * Int(s / 10), 2 + (i Mod 9) + 10 * (s Mod 10)) = 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)
Sheet2.Cells(12 + Int((i - 81) / 9) + 20 * Int(s / 10), 2 + ((i - 81) Mod 9) + 10 * (s Mod 10)) = a(i)
Next
If a(162) = 0 Then Cells(10, 12) = "左右対称型"
If a(162) = 1 Then Cells(10, 12) = "上下対称型"
If a(162) = 2 Then Cells(10, 12) = "点対称型"
If a(162) = 3 Then Cells(10, 12) = "線対称かつ点対称型"
If a(162) = 4 Then Cells(10, 12) = "非対称型"
If a(162) = 5 Then Cells(10, 12) = "ハート型"
CommandButton3_Click
If sng = 0 Then Exit For
Cells(4 + Int(s / 10), 26 + (s Mod 10)) = "〇"
Cells(3, 26) = 100 * ((s + 1) / 最後)
Next
If sng = 1 Then Cells(11, 12) = "すべて正常でした。" Else Cells(11, 12) = "異常がありました。"
ow = Timer
Cells(7, 18) = "数独作成にかかった時間は平均で"
Cells(8, 18) = (ow - hj) / 最後
Cells(9, 18) = "秒です。"
Cells(9, 22) = "試行回数"
Cells(9, 24) = 最後
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:L11").Select
Selection.ClearContents
Range("V9:X9").Select
Selection.ClearContents
Sheets("Sheet2").Select
Sheet2.Cells.Select
Selection.ClearContents
Sheets("Sheet1").Select
Range("A2").Select
End Sub
Private Sub CommandButton3_Click()
Range("R6:R10").Select
Selection.ClearContents
Dim i As Byte
Dim j As Byte
Worksheets("Sheet1").Cells(3, 1).Select
ktcn = 0
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
sng = 0
kisokaiseki
sakusei (0)
End If
If sng = 1 Then
Cells(6, 18) = "理詰め(確定法)のみで解けました。"
'Cells(3, 12) = Cells(3, 12) + 1
Else
Cells(6, 18) = "理詰めでは解けませんでした。"
Exit Sub
End If
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