He preparado una herramienta para facilitar, facilitar no resolver, la resolución de sudokus. En una hoja excel pongo a la izquierda el sudoku, con sus valores y sus separaciones, y a la derecha pongo un cuadro similar que da los posibles valores de cada celda si en el original está en blanco o el valor de la celda original si esta no está en blanco. ¿Como lo hago? Al cambiar el valor de una celda lanzo el proceso que encuentra los posibles valores que puede tomar esa celda. Como respuesta a ese evento lanzo un procedimiento.
Estamos en lo de siempre cuando nos referimos a los eventos. Un evento es cualquier acción reconocible por la aplicación que realicemos sobre, en este caso, una hoja excel. Los eventos son actuaciones como seleccionar o deseleccionar una hoja, hacer doble clic, modificar un valor, recalcular el valor de las fórmulas, etc.
Como respuesta a cualquiera de estas acciones podemos querer un cierto tipo de respuesta, normalmente una respuesta mas compleja que la que se pueda dar con formulas y formatos condicionales. En definitiva una respuesta que necesite programación.
La respuesta a los eventos "de hoja" tiene un nombre concreto para cada evento y debe estar situada en módulo de la propia hoja. Pinchando con el botón derecho del ratón en la solapa de la hoja podemos entrar en el módulo con "ver código". Como ya he dicho hay una serie de procedimientos con su propio nombre, y con sus propios parámetros, aunque el nombre de las variables se puede cambiar, que responden al evento correspondiente.
Cuando la hoja activa pierde el foco. Al cambiar de hoja.
******************************************************
Private Sub Worksheet_deactivate()
'MsgBox "Adios"
End Sub
******************************************************
Al seleccionar la hoja.
******************************************************
Private Sub Worksheet_Activate()
'MsgBox "Hola"
End Sub
******************************************************
Al hacer doble clic
******************************************************
Private Sub Worksheet_BeforeDoubleClick(ByVal Ran As Range, Cancel As Boolean)
'MsgBox "Clic-clic"
End Sub
******************************************************
Al recalcular una hoja.
*****************************************************
Private Sub Worksheet_Calculate()
' Columns("A:F").AutoFit
End Sub
******************************************************
******************************************************
Al utilizar el botón derecho del ratón.
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, _
Cancel As Boolean)
' MsgBox "no lo hagas"
End Sub
Al hacer doble clic: Al hacer doble clic nos lleva de la celda con posibles contenidos a la correspondiente celda en el sudoku.
******************************************************
******************************************************
Private Sub Worksheet_BeforeDoubleClick(ByVal Celda As Range, Cancel As Boolean)
F = Celda.Row
C = Celda.Column
If C >= 13 And C <= 21 And F >= 2 And F <= 10 Then Celda.Offset(0, -11).Select
End Sub
******************************************************
***************************************************** Private Sub Worksheet_SelectionChange(ByVal Celda As Range)
'MsgBox Celda.Address
End Sub
******************************************************
F = Celda.Row
C = Celda.Column
If C >= 13 And C <= 21 And F >= 2 And F <= 10 Then Celda.Offset(0, -11).Select
End Sub
******************************************************
***************************************************** Private Sub Worksheet_SelectionChange(ByVal Celda As Range)
'MsgBox Celda.Address
End Sub
En mi facilitador de sudokus manejo el evento "Al cambiar el valor de una celda:"
******************************************************
Private Sub Worksheet_Change(ByVal Celda As Range)
Dim D, F, C
' la variable pasada,Celda, es un rango, se refiere a la celda que acabamos de cambiar el valor.
' No todas las celdas de la hoja forman parte del sudoku. Lo primero que tengo que hacer es conocer si la celda modificada está o no esta en el rango del sudoku, es una de celdas que desencadenan el procedimiento "Al cambiar". Para ello debo conocer la fila y la columna, dentro de la hoja, que ocupa la celda.
'
F = Celda.Row ' Fila de la celda.
C = Celda.Column ' Columna de la celda.
D = Celda.Address ' Dirección de la celda. Aunque luego no la utilice
' El rango del sudoku es B2:J10. Por tanto, las celdas útiles están situadas entre la columna 2, fila 2 y la columna 10, fila 10
If C >= 2 And C <= 10 And F >= 2 And F <= 10 Then
RangoCompuesto ' Proceso datos.
End If
End Sub
******************************************************
Cuando se incluye o modifica un número en una celda:
- El proceso recorre todo el rango del sudoku, pasando por todas las celdas.
- Las reglas del sudoku dicen que un número no debe repetirse ni en la línea, ni en la columna, ni en el rango de 3*3 que contiene a la celda en cuestión.
- Debo, antes de ver si un número se repite o no, encontrar el rango compuesto de la celda en cuestión.
Sub RangoCompuesto()
Dim D, V, F As Integer, C, Ran, R1, R2, Cad, Num, Val
Cad = "123456789"
With ActiveSheet
For Each Celda In .Range("b2:j10") ' Rango del Sudoku
Val = Trim(Celda.Value) 'Valor de la celda
If Val = "" Then
'***********************************************
'Encontrar fila y columna de la celda procesada se puede hacer de dos maneras, a partir de la dirección o directamente con row y column. En este caso, puede que resulte mas sencillo utilizar la dirección.
D = Celda.Address 'Dirección de la celda.
D = Celda.Address 'Dirección de la celda.
V = Split(D, "$") 'Convierte o pasa la dirección a una matriz columna (en letra) y fila
'F = Celda.Row
'C = Celda.Column - 2
F = V(2)
C = Asc(V(1)) - 66 ' En este caso la primera columna del sudoku es la B, ascii 66. En este caso interesa que la primera columna, en número, sea cero.
Ran = "b" & F & ":" & "J" & F & "," & V(1) & 2 & ":" & V(1) & 10
R1 = Int((F - 2) / 3) * 3 ' Esta operación permite encontrar la celda de mas arriba y mas a la izquierda de cada grupo 3*3 de celdas del sudoku.
R2 = Int(C / 3) * 3
D = .Range(.Cells(R1 + 2, R2 + 2), .Cells(R1 + 4, R2 + 4)).Address
Ran = Ran & "," & D
.Range(Ran).Select
' Encontrado el rango, recorre todas las celdas de ese rango con un "para cada celda en un rango"
'******************************************************
For Each Celda2 In .Range(Ran)
Num = Celda2.Value
Cad = Replace(Cad, Num, "") ' La cadena Cad contiene los nueve números utilizados en el sudoku. El proceso Reemplaza todo numero encontrado con una cadena nula ""
Next
'******************************************************
End If
If Val = "" Then
Celda.Offset(0, 11) = "*" & Cad & "*" ''Escribe lo que queda de la cadena Cad
Else
''Si la celda contiene un número, en la imagen escribe ese número.
''Si la celda contiene un número, en la imagen escribe ese número.
Celda.Offset(0, 11) = Val
End If
Cad = "123456789"
Next
' .Columns("m:u").AutoFit
End With
'
End Sub
No hay comentarios:
Publicar un comentario