Option Explicit
Private arrResult
Public Sub hello()
Dim arr, r As Long, c As Long, dArr, str As String
arr = Sheet2.Range("A12").Resize(9, 9).Value
arrResult = ""
Solve arr
Sheet2.Range("M2").Resize(9, 9).ClearContents
Sheet2.Range("M2").Resize(9, 9).Value = arrResult
End Sub
Private Sub Solve(ByVal arr)
If Not IsArray(arrResult) Then
Dim r As Long, c As Long, tmpMin(1 To 3), str, has1situ As Boolean
For r = 1 To 9 Step 1
For c = 1 To 9 Step 1
If arr(r, c) = "" Then
str = situ(r, c, arr)
If Len(str) = 0 Then GoTo kt
If Len(str) = 1 Then
arr(r, c) = str
has1situ = True
Else
If Not has1situ Then
If Len(tmpMin(3)) = 0 Or Len(str) < Len(tmpMin(3)) Then
tmpMin(1) = r: tmpMin(2) = c: tmpMin(3) = str
End If
End If
End If
End If
Next
Next
If IsFinish(arr) Then
arrResult = arr
Else
If has1situ Then
Solve arr
Else
For r = 1 To Len(tmpMin(3)) Step 1
arr(tmpMin(1), tmpMin(2)) = Mid(tmpMin(3), r, 1)
Solve arr
Next
End If
End If
End If
kt:
End Sub
'get all situation for target cell ( i , j)
Private Function situ(i As Long, j As Long, arr) As String
Dim r As Long, c As Long
situ = "123456789"
For c = 1 To 9 Step 1
If arr(i, c) <> "" Then situ = Replace(situ, arr(i, c), "")
Next
For r = 1 To 9 Step 1
If arr(r, j) <> "" Then situ = Replace(situ, arr(r, j), "")
Next
For r = 3 * WorksheetFunction.RoundUp(i / 3, 0) - 2 To 3 * WorksheetFunction.RoundUp(i / 3, 0) Step 1
For c = 3 * WorksheetFunction.RoundUp(j / 3, 0) - 2 To 3 * WorksheetFunction.RoundUp(j / 3, 0) Step 1
If arr(r, c) <> "" Then situ = Replace(situ, arr(r, c), "")
Next
Next
End Function
Private Function IsFinish(arr) As Boolean
Dim r As Long, c As Long
IsFinish = False
For r = 1 To 9 Step 1
For c = 1 To 9 Step 1
If arr(r, c) = "" Then Exit Function
Next
Next
IsFinish = True
End Function
