in.txt
410709600286035097007000200000501040030007528900000100740203069168000050300008014
000500010008603000090070308000000200005016804034200001040008000000100795760952000
out.txt
4 1 3 7 2 9 6 8 5
2 8 6 1 3 5 4 9 7
5 9 7 8 4 6 2 3 1
8 7 2 5 6 1 9 4 3
6 3 1 4 9 7 5 2 8
9 5 4 3 8 2 1 7 6
7 4 5 2 1 3 8 6 9
1 6 8 9 7 4 3 5 2
3 2 9 6 5 8 7 1 4
4 7 3 5 8 9 6 1 2
1 5 8 6 2 3 9 4 7
2 9 6 4 7 1 3 5 8
6 1 7 8 4 5 2 3 9
9 2 5 3 1 6 8 7 4
8 3 4 2 9 7 5 6 1
5 4 9 7 3 8 1 2 6
3 8 2 1 6 4 7 9 5
7 6 1 9 5 2 4 8 3
'此方法為找到某一個只能輸入1個特定數字，就輸入
回覆刪除'適用於初階、中階
Dim X(9, 9)
Dim Y(9) As Byte '檢查用
Private Sub Form_Load()
Me.Hide
Open App.Path & "\in.txt" For Input As #1
Open App.Path & "\out.txt" For Output As #2
Do While Not EOF(1)
Line Input #1, N
For i = 1 To Len(N)
A = Val(Mid(N, i, 1))
If A <> 0 Then Text1(i).Text = A: Text1(i).ForeColor = vbRed
Next i
m = 1
For i = 1 To 9
For j = 1 To 9
X(j, i) = Val(Mid(N, m, 1))
m = m + 1
Next j
Next i
Do
For i = 1 To 9
For j = 1 To 9
If X(j, i) = 0 Then
NN = check(j, i)
If Len(NN) = 1 Then X(j, i) = NN
End If
Next j
Next i
Loop Until Over = True
m = 1
For i = 1 To 9
For j = 1 To 9
Text1(m).Text = X(j, i)
m = m + 1
Next j
Next i
For i = 1 To 9
For j = 1 To 9
Print #2, X(j, i) & " ";
If j Mod 9 = 0 Then Print #2,
Next j
Next i
Print #2,
Loop 'Do while not EOF(1)
Close #2
Close #1
End
End Sub
Function check(A, B) '挑出可用數
ans = ""
Dim OK(9) As Boolean
For i = 1 To 9
OK(i) = True
Next i
For i = 1 To 9
Y(i) = X(A, i)
Next i
For i = 1 To 9
If check2(i) = False Then OK(i) = False
Next i
For i = 1 To 9
Y(i) = X(i, B)
Next i
For i = 1 To 9
If check2(i) = False Then OK(i) = False
Next i
Select Case A
Case 1 To 3: AI = 1: AJ = 3
Case 4 To 6: AI = 4: AJ = 6
Case 7 To 9: AI = 7: AJ = 9
End Select
Select Case B
Case 1 To 3: BI = 1: BJ = 3
Case 4 To 6: BI = 4: BJ = 6
Case 7 To 9: BI = 7: BJ = 9
End Select
N = 1
For i = AI To AJ
For j = BI To BJ
Y(N) = X(i, j)
N = N + 1
Next j
Next i
For i = 1 To 9
If check2(i) = False Then OK(i) = False
Next i
For i = 1 To 9
If OK(i) = True Then ans = ans & i
Next i
check = ans
End Function
Function check2(C) As Boolean '看有無重複
P = True
For i = 1 To 9
If Y(i) = C Then P = False: Exit For
Next i
check2 = P
End Function
Function Over() As Boolean '判斷是否完成
P = True
For i = 1 To 9
For j = 1 To 9
If X(j, i) = 0 Then P = False: Exit For
Next j
Next i
Over = P
End Function
Dim n(9, 9) As String, x As String, y, ban, over, times, allsp
回覆刪除Private Sub Form_Load()
Me.Hide
Open App.Path & "\in.txt" For Input As #1
Open App.Path & "\out.txt" For Output As #2
Do While Not EOF(1)
Line Input #1, nn
k = 1
For i = 1 To 9
For j = 1 To 9
For mm = k To 81
n(j, i) = Mid(nn, mm, 1): k = mm + 1: Exit For
Next
Next
Next
over = False
Do While over = False
'\\\\\\\\
allsp = 0
times = times + 1
'\\\\\\\\\
For i = 1 To 9
For j = 1 To 9
If n(j, i) = 0 Then '***
'\\\\
allsp = allsp + 1
'\\\\
'MsgBox x & " " & y
x = j: y = i
ban = ""
For m = 1 To 9
ban = ban & " " & n(x, m)
Next
For m = 1 To 9
ban = ban & " " & n(m, y)
Next
Call Area((x), (y))
List1.Clear
'
For m = 1 To 9
If InStr(ban, m) = 0 Then List1.AddItem m:
Next
If List1.ListCount = 1 Then n(x, y) = List1.List(0):
End If '***
Next
Next
Call overcheck
Loop
Pr:
For i = 1 To 9
For j = 1 To 9
Print #2, n(j, i);
Next
Print #2, ""
Next
Loop
Close
Close
End
End Sub
Sub overcheck()
over = True
For i = 1 To 9
For j = 1 To 9
If n(j, i) = "0" Then over = False
Next
Next
End Sub
Sub Area(a, b)
Do Until a = 3 Or a = 6 Or a = 9
a = a + 1
Loop
Do Until b = 3 Or b = 6 Or b = 9
b = b + 1
Loop
For i = a - 2 To a
For j = b - 2 To b
ban = ban & n(i, j)
Next
Next
End Sub