[Código] Mostrando los Candidatos de un Sudoku

Siempre que me he puesto a resolver algun sudoku mi primer problema era obtener los candidatos para cada celda vacia, luego de un largo quebradero de cabeza los hallaba pero cabia la posibilidad de caer en errores, algunos sudoku on-line te permitian ver todos los candidatos de una celda pero para sus propios sudokus, en mi caso mis sudokus son de mi telefono movil y alli no tengo tal opcion, de manera que me puse a codear en VB y he aqui este pequeño código que obtiene los candidatos para las celdas de un sudoku correctamente propuesto. Lo he hecho en el control MSHFlexGrid por lo que se debe agregar en los componentes para que el programa pueda ejecutar correctamente.

Es evidente que el programa NO RESUELVE un sudoku, lo cual me parece bien, pues para resolverlo, cada uno debe poder hacerlo y asi ejercitarse, ademas que terminarlo es bastante gratificante, aunque debe serlo tambien realizar un code que haga que el propio ordenador lo haga por nosotros. En fin gusto de cada uno, en mi caso prefiero resolverlo manualmente.

Bueno, sin mas, aquí el código para quien le sirva:

Código:

Option Explicit
'9 filas x 9 columnas
Dim Sud(1 To 9, 1 To 9) As Byte



Private Sub CMDLLenar_Click()

Dim f As Byte
Dim c As Byte


'cargamos el SUDOKU con sus valores originales FIJOS
Sud(1, 2) = 9
Sud(1, 4) = 6
Sud(1, 6) = 5

Sud(2, 7) = 8
Sud(2, 9) = 1

Sud(3, 1) = 2
Sud(3, 5) = 3
Sud(3, 8) = 6

Sud(4, 1) = 3
Sud(4, 2) = 8
Sud(4, 5) = 9

Sud(6, 5) = 1
Sud(6, 8) = 2
Sud(6, 9) = 7

Sud(7, 2) = 1
Sud(7, 5) = 8
Sud(7, 9) = 9

Sud(8, 1) = 6
Sud(8, 3) = 4

Sud(9, 4) = 2
Sud(9, 6) = 7
Sud(9, 8) = 5



'visualizamos el array en el Hierarchical
For c = 1 To 9
    For f = 1 To 9
     If Sud(f, c) <> 0 Then
      Colocar f, c, Sud(f, c)
     End If
    Next
Next

'coloreamos de rojo los numeros fijos para diferenciarlos de los candidatos
Dim fila1 As Integer
Dim columna1 As Integer
With H1
   ' Recorre las filas
    For fila1 = 0 To 8
        For columna1 = 0 To 8
        .Row = fila1
        .Col = columna1
         If Val(.Text) > 0 Then
            .CellForeColor = &HFF& 'rojooo
         End If
         Next
    Next
    
    
    
    'coloreamos algunas regiones para diferenciar
    For fila1 = 0 To 2
        For columna1 = 0 To 2
        .Row = fila1
        .Col = columna1
            .CellBackColor = RGB(127, 220, 98)
         Next
    Next


    For fila1 = 3 To 5
        For columna1 = 3 To 5
        .Row = fila1
        .Col = columna1
            .CellBackColor = RGB(127, 123, 208)
         Next
    Next

    For fila1 = 6 To 8
        For columna1 = 6 To 8
        .Row = fila1
        .Col = columna1
            .CellBackColor = RGB(247, 123, 198)
         Next
    Next

    For fila1 = 0 To 2
        For columna1 = 6 To 8
        .Row = fila1
        .Col = columna1
            .CellBackColor = RGB(247, 220, 198)
         Next
    Next

    For fila1 = 6 To 8
        For columna1 = 0 To 2
        .Row = fila1
        .Col = columna1
            .CellBackColor = RGB(47, 220, 198)
         Next
    Next

End With


End Sub

Private Sub Command1_Click()


'///////////// Iniciamos a visualizar los candidatos ///////////


Dim Candidatos As Byte

Dim Casas As Byte '9 regiones o casas

For Casas = 1 To 9 'buscaremos los candidatos en las 9 casas o regiones
    For Candidatos = 1 To 9
      BuscarCandidatos Casas, Candidatos 'buscamos los candidatos posibles en las 9 casas
    Next
Next
  

End Sub
'Funcion que busca un valor en la fila indicada
Private Function BuscarFila(Fila As Byte, ValorBuscado As Byte)
Dim c As Byte
For c = 1 To 9
 If Sud(Fila, c) = ValorBuscado Then
  BuscarFila = True
  Exit Function
 Else
 BuscarFila = False
 End If
Next
End Function
'Funcion que busca un valor en la columna indicada
Private Function BuscarColumna(Columna As Byte, ValorBuscado As Byte)
Dim f As Byte
For f = 1 To 9
 If Sud(f, Columna) = ValorBuscado Then
  BuscarColumna = True
  Exit Function
  Else
  BuscarColumna = False
 End If
Next

End Function

'Funcion que nos dice si un valor indicado existe o no en una region o casa indicada
Function Encontrar(Casa As Byte, Valor As Byte) As Boolean
Dim f As Byte, c As Byte
    
    If Casa = 1 Then 'quiere decir que se va a buscar en la casa 1
        For f = 1 To 3 'busqueda por filas
              For c = 1 To 3
                If Sud(f, c) = Valor Then
                 Encontrar = True
                 Exit Function
                End If
              Next
        Next
    End If
    
    If Casa = 2 Then 'quiere decir que se va a buscar en la casa 2
        For f = 1 To 3 'busqueda por filas
              For c = 4 To 6
                If Sud(f, c) = Valor Then
                 Encontrar = True
                 Exit Function
                End If
              Next
        Next
    End If

    If Casa = 3 Then 'quiere decir que se va a buscar en la casa 3
        For f = 1 To 3 'busqueda por filas
              For c = 7 To 9
                If Sud(f, c) = Valor Then
                 Encontrar = True
                 Exit Function
                End If
              Next
        Next
    End If

    If Casa = 4 Then
        For f = 4 To 6 'busqueda por filas
              For c = 1 To 3
                If Sud(f, c) = Valor Then
                 Encontrar = True
                 Exit Function
                End If
              Next
        Next
    End If

    If Casa = 5 Then
        For f = 4 To 6 'busqueda por filas
              For c = 4 To 6
                If Sud(f, c) = Valor Then
                 Encontrar = True
                 Exit Function
                End If
              Next
        Next
    End If

    If Casa = 6 Then
        For f = 4 To 6 'busqueda por filas
              For c = 7 To 9
                If Sud(f, c) = Valor Then
                 Encontrar = True
                 Exit Function
                End If
              Next
        Next
    End If

    If Casa = 7 Then
        For f = 7 To 9 'busqueda por filas
              For c = 1 To 3
                If Sud(f, c) = Valor Then
                 Encontrar = True
                 Exit Function
                End If
              Next
        Next
    End If

    If Casa = 8 Then
        For f = 7 To 9 'busqueda por filas
              For c = 4 To 6
                If Sud(f, c) = Valor Then
                 Encontrar = True
                 Exit Function
                End If
              Next
        Next
    End If

    If Casa = 9 Then
        For f = 7 To 9 'busqueda por filas
              For c = 7 To 9
                If Sud(f, c) = Valor Then
                 Encontrar = True
                 Exit Function
                End If
              Next
        Next
    End If


End Function

'procedimiento que simplemente coloca un valor en el Flex Grid
Private Sub Colocar(Fila As Byte, Columna As Byte, Valor As Byte)
 Dim a As Byte, b As Byte
 Dim fila1 As Integer
 With H1
 .TextMatrix(Fila - 1, Columna - 1) = .TextMatrix(Fila - 1, Columna - 1) & Valor
 End With
End Sub


'iniciamos la busqueda de candidatos
Private Sub BuscarCandidatos(Casa As Byte, ValorBuscadoEnLaCasa As Byte)
Dim f1 As Byte
Dim f2 As Byte
Dim c1 As Byte
Dim c2 As Byte

'establemos las coordenadas para cada region o casa
Select Case Casa
 
 Case 1:
  f1 = 1
  f2 = 3
  c1 = 1
  c2 = 3
  
 Case 2:
  f1 = 1
  f2 = 3
  c1 = 4
  c2 = 6
 
 Case 3:
  f1 = 1
  f2 = 3
  c1 = 7
  c2 = 9
  
 Case 4:
  f1 = 4
  f2 = 6
  c1 = 1
  c2 = 3
  
 Case 5:
  f1 = 4
  f2 = 6
  c1 = 4
  c2 = 6
  
 Case 6:
  f1 = 4
  f2 = 6
  c1 = 7
  c2 = 9
  
 Case 7:
  f1 = 7
  f2 = 9
  c1 = 1
  c2 = 3
  
 Case 8:
  f1 = 7
  f2 = 9
  c1 = 4
  c2 = 6
 
 Case 9:
  f1 = 7
  f2 = 9
  c1 = 7
  c2 = 9
 
End Select

Dim f As Byte
Dim c As Byte


     If Encontrar(Casa, ValorBuscadoEnLaCasa) = False Then 'si el valor buscado no es un numero FIJO
         
        For f = f1 To f2 'busqueda por filas
              For c = c1 To c2
                      If Sud(f, c) = 0 Then 'si esta vacio entonces alli debemos poner un candidato
                            'para que sea candidato, no debe estar ni en la fila ni en la columna (mucho menos en la region o casa)
                            If BuscarFila(f, ValorBuscadoEnLaCasa) = False And BuscarColumna(c, ValorBuscadoEnLaCasa) = False Then
                              Colocar f, c, ValorBuscadoEnLaCasa 'de ser asi entonces se considera como candidato
                            End If
                      End If
              Next
        Next
        
     End If
End Sub

Private Sub Form_Load()
Dim f As Byte, c As Byte
For f = 0 To 8
H1.RowHeight(f) = 700
Next
For f = 0 To 8
H1.ColWidth(f) = 700
Next
End Sub

El sudoku propuesto: (Boton Iniciar Sudoku)

El sudoku propuesto con todos sus candidatos: (Boton Encontrar Candidatos)