ya que me estoy desvelando lo hize... como ven uso el metodo Recursivo para implementar el BackTracking.
* me falta optimizar algunos aspectos... no les dire donde para que no me roben xP.
Option Explicit
Private Sub Form_Load()
Dim bSudoku(8, 8) As Byte ' // (nFilas, nColumnas)
bSudoku(0, 0) = 5
bSudoku(0, 1) = 3
bSudoku(0, 4) = 7
bSudoku(1, 0) = 6
bSudoku(1, 3) = 1
bSudoku(1, 4) = 9
bSudoku(1, 5) = 5
bSudoku(2, 1) = 9
bSudoku(2, 2) = 6
bSudoku(2, 7) = 1
bSudoku(3, 0) = 8
bSudoku(3, 4) = 6
bSudoku(3, 8) = 3
bSudoku(4, 0) = 4
bSudoku(4, 3) = 8
bSudoku(4, 5) = 3
bSudoku(4, 8) = 1
bSudoku(5, 0) = 7
bSudoku(5, 4) = 2
bSudoku(5, 8) = 6
bSudoku(6, 1) = 6
bSudoku(6, 6) = 2
bSudoku(6, 7) = 8
bSudoku(7, 3) = 4
bSudoku(7, 4) = 1
bSudoku(7, 5) = 9
bSudoku(7, 8) = 5
bSudoku(8, 4) = 8
bSudoku(8, 7) = 7
bSudoku(8, 8) = 9
Debug.Print "Inicial"
showSudoku bSudoku
MsgBox solveSudoku(bSudoku, 0, 0) ' // Por BackTracking
Debug.Print "Resuelto"
showSudoku bSudoku
End Sub
Public Sub showSudoku(ByRef bArray() As Byte)
Dim i As Integer
Dim j As Integer
For i = 0 To UBound(bArray, 1)
For j = 0 To UBound(bArray, 2)
Debug.Print bArray(i, j);
Next
Debug.Print
Next
Debug.Print
Debug.Print
End Sub
Public Function solveSudoku(ByRef bArray() As Byte, ByVal iRow As Long, ByVal iCol As Long) As Boolean
' // Me falta optimizar el proceso... Version 1.0.
Dim lVal As Long
Dim i As Long
If (iRow >= 9) Then
solveSudoku = True
Exit Function
End If
Do While Not (bArray(iRow, iCol) = &H0) ' // Nos posicionamos en la 1ra celda de iRow vacia (con valor 0).
iCol = (iCol + &H1)
If (iCol = 9) Then
iCol = &H0
iRow = (iRow + &H1)
If (iRow >= &H9) Then
solveSudoku = True
Exit Function
End If
End If
Loop
For lVal = 1 To 9 ' // Buscamos un valor valido para la celda...
For i = 0 To 8 ' // Verificamos cada celda de la columna iCol.
If (bArray(i, iCol) = lVal) Then
i = (-1)
Exit For
End If
Next
If Not (i = (-1)) Then
For i = 0 To 8 ' // Verificamos cada celda de la Fila iRow.
If (bArray(iRow, i) = lVal) Then
i = (-1)
Exit For
End If
Next
If Not (i = (-1)) Then
bArray(iRow, iCol) = lVal ' // Seteamos su valor.
If (iCol < 8) Then ' // Avazamos a la siguiente celda a resolver.
solveSudoku = solveSudoku(bArray, iRow, iCol + 1)
If Not solveSudoku Then
bArray(iRow, iCol) = 0 ' // Error entonces volvemos atras.
End If
Else
solveSudoku = solveSudoku(bArray, iRow + 1, 0)
If Not solveSudoku(bArray, iRow + 1, 0) Then
bArray(iRow, iCol) = 0 ' // Error entonces volvemos atras.
End If
End If
End If
End If
Next
End Function
output:
Inicial
5 3 0 0 7 0 0 0 0
6 0 0 1 9 5 0 0 0
0 9 6 0 0 0 0 1 0
8 0 0 0 6 0 0 0 3
4 0 0 8 0 3 0 0 1
7 0 0 0 2 0 0 0 6
0 6 0 0 0 0 2 8 0
0 0 0 4 1 9 0 0 5
0 0 0 0 8 0 0 7 9
Resuelto
5 3 1 2 7 6 4 9 8
6 2 4 1 9 5 8 3 7
3 9 6 5 4 8 7 1 2
8 5 2 9 6 7 1 4 3
4 7 9 8 5 3 6 2 1
7 1 8 3 2 4 9 5 6
9 6 5 7 3 1 2 8 4
2 8 7 4 1 9 3 6 5
1 4 3 6 8 2 5 7 9
Temibles Lunas!¡.
Autor
En línea
