¿Cómo armar una sopa de letras automatizada en Excel?
En el video tutorial ejemplificamos como podemos desarrollar una sopa de letras interactiva de forma automatizada, mediante el uso de módulos de visual basic, botones y hojas auxiliares.
Básicamente la idea consiste en generar tres hojas denominadas “juego”, “respuestas” y “auxiliar”.
En la hoja “juego” creamos una grilla de 20×20 en el rango A1:T20 y la nombramos “grilla”. Luego aplicamos una lista desplegable sobre la celda W3 que contiene los niveles de dificultad “FÁCIL”, “INTERMEDIO” y “DIFÍCIL”. A esta celda la nombramos “nivel”. Cada uno de estos niveles tiene por condición en el módulo diseñado traer un determinado número de palabras para buscar, donde “FÁCIL” devuelve 4 palabras, “INTERMEDIO” devuelve 7 palabas y “DIFÍCIL” devuelve 10 palabras. Estas palabras de búsqueda van a aparecer en el rango AA1:AA10 de la hoja “juego”.
En la hoja “respuestas” creamos una grilla en el rango A1:A10 y la nombramos valores_respuestas. Es aquí sobre este rango donde debemos escribir las palabas que vamos a querer buscar en nuestra sopa de letras. Es importante que las palabras no contengan espacios, es decir no utilizar palabras compuestas. De este rango van a obtenerse la cantidad requerida de palabras de forma aleatoria en función del nivel de dificultad elegido (el cual define la cantidad de palabras a buscar).
En la hoja “auxiliar” creamos una grilla en el rango A1:A10 y la nombramos valores_auxiliar. Este rango no lo utilizaremos activamente, sino que es el rango donde el módulo diseñado va a devolvernos como resultado las palabras a buscar de forma aleatoria. Este rango es el que luego va a verse representado en la hoja “juego” en el rango AA1:AA10.
La instrucción que debemos copiar dentro de la ventana de visual basic y de nuestra hoja1 “juego”, es la siguiente:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim EstaPalabra, EstaPalabraInversa, Rango As String
Dim Efila, Errores As Integer
Dim Celda As Range
If Target.Row > Range("grilla").Rows.Count Then
Exit Sub
ElseIf Target.Column > Range("grilla").Columns.Count Then
Exit Sub
End If
Errores = 0
If Target.Areas.Count > 1 Then
Exit Sub
ElseIf Target.Rows.Count > 1 And Target.Columns.Count > 1 Then
Exit Sub
Else
Rango = Target.Address
For Each Celda In Selection.Cells
EstaPalabra = Trim(EstaPalabra) & Trim(Celda.Value)
Next Celda
buscar_de_nuevo:
On Error Resume Next
Columns("AA:AA").Select
Efila = Selection.Find(What:=EstaPalabra, after:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Row
If Err.Number <> 0 Then
Errores = Errores + 1
If Errores = 2 Then
MsgBox "La palabra seleccionada no existe en la lista", vbCritical, "Error"
Range("v7").Select
Exit Sub
End If
For X = Len(EstaPalabra) To 1 Step -1
EstaPalabraInversa = EstaPalabraInversa & Mid(EstaPalabra, X, 1)
Next X
EstaPalabra = EstaPalabraInversa
GoTo buscar_de_nuevo
Else
MsgBox "La palabra " & EstaPalabra & " está correctamente seleccionada", vbInformation
Range(Rango).Font.Color = vbWhite
Range(Rango).Interior.Color = vbBlue
Range("v7").Select
End If
End If
End Sub
|
Luego, la instrucción que debemos copiar dentro de la ventana de visual basic y en un módulo nuevo, es la siguiente:
Sub Inicio()
If Range("nivel").Value = "" Then
MsgBox "Seleccione la cantidad de palabras a buscar", vbExclamation, "Faltan datos"
Exit Sub
End If
SeleccionarPalabras
ColocarPalabrasEnLaGrilla
RellenarGrilla
End Sub
Sub SeleccionarPalabras()
Dim aleaF, X, UltimaFila, FilaBuscar, J As Integer
Dim Palabras As Byte
Dim Palabra As String
Sheets("auxiliar").Range("valores_auxiliar").ClearContents
UltimaFila = Sheets("respuestas").Cells(65536, 1).End(xlUp).Row
Select Case Sheets("juego").Range("nivel").Value
Case Is = "FÁCIL"
Palabras = 4
Case Is = "INTERMEDIO"
Palabras = 7
Case Is = "DIFÍCIL"
Palabras = 10
End Select
Randomize
For X = 1 To Palabras
de_nuevo:
aleaF = Int((UltimaFila * Rnd) + 1)
Palabra = UCase(Sheets("respuestas").Cells(aleaF, 1).Value)
On Error Resume Next
FilaBuscar = Sheets("auxiliar").Range("valores_auxiliar").Find(Palabra).Row
If Err.Number <> 0 Then
J = J + 1
Sheets("auxiliar").Cells(J, 1).Value = Palabra
Else
GoTo de_nuevo
End If
Next X
End Sub
Sub ColocarPalabrasEnLaGrilla()
Dim Uf, X, J, aleaF, aleaC As Integer
Dim Palabra, Letra As String
Dim Resultado, Posi As Byte
Uf = Sheets("auxiliar").Cells(65536, 1).End(xlUp).Row
Range("grilla").ClearContents
Columns("AA").ClearContents
For X = 1 To Uf
Palabra = UCase(Sheets("auxiliar").Cells(X, 1).Value)
otra_vez:
Posi = 0
aleaF = Int((Sheets("juego").Range("grilla").Rows.Count * Rnd) + 1)
aleaC = Int((Sheets("juego").Range("grilla").Columns.Count * Rnd) + 1)
If Sheets("juego").Cells(aleaF, aleaC).Value = "" Then
Resultado = AnalizarCamino(aleaF, aleaC, Palabra)
Select Case Resultado
Case 1
For J = aleaF To (aleaF - Len(Palabra) + 1) Step -1
Posi = Posi + 1
Cells(J, aleaC).Value = Mid(Palabra, Posi, 1)
Next J
Case 2
For J = aleaF To (aleaF + (Len(Palabra) - 1))
Posi = Posi + 1
Cells(J, aleaC).Value = Mid(Palabra, Posi, 1)
Next J
Case 3
For J = aleaC To (aleaC - Len(Palabra) + 1) Step -1
Posi = Posi + 1
Cells(aleaF, J).Value = Mid(Palabra, Posi, 1)
Next J
Case 4
For J = aleaC To (aleaC + (Len(Palabra) - 1))
Posi = Posi + 1
Cells(aleaF, J).Value = Mid(Palabra, Posi, 1)
Next J
Case 0
GoTo otra_vez
End Select
Else
GoTo otra_vez
End If
ttt = ttt + 1
Range("aa" & ttt).Value = Palabra
Next X
End Sub
Sub RellenarGrilla()
Dim Filas, Columnas, Letra As Byte
Dim F, C As Integer
Range("grilla").Font.Color = vbBlack
Range("grilla").Interior.Color = vbWhite
Filas = Range("grilla").Rows.Count
Columnas = Range("grilla").Columns.Count
Letra = 65
Randomize
For C = 1 To Columnas
For F = 1 To Filas
If Cells(F, C).Value = "" Then
Cells(F, C).Value = Chr(Int((90 - 65 + 1) * Rnd + 65))
End If
Next F
Next C
End Sub
Function AnalizarCamino(fila, columna, p) As Byte
Dim Largo, X As Byte
Dim Rng As Range
Largo = Len(p)
AnalizarCamino = 0
If Largo <= fila Then
Set Rng = Range(Cells(fila, columna), Cells((fila - Largo) + 1, columna))
If Application.WorksheetFunction.CountA(Rng) = 0 Then
AnalizarCamino = 1
GoTo salida
End If
End If
If (fila + Largo - 1) <= Range("grilla").Rows.Count Then
Set Rng = Range(Cells(fila, columna), Cells((fila + Largo) - 1, columna))
If Application.WorksheetFunction.CountA(Rng) = 0 Then
AnalizarCamino = 2
GoTo salida
End If
End If
If Largo <= columna Then
Set Rng = Range(Cells(fila, columna), Cells(fila, (columna - Largo) + 1))
If Application.WorksheetFunction.CountA(Rng) = 0 Then
AnalizarCamino = 3
GoTo salida
End If
End If
If (columna + Largo - 1) <= Range("grilla").Columns.Count Then
Set Rng = Range(Cells(fila, columna), Cells(fila, (columna + Largo) - 1))
If Application.WorksheetFunction.CountA(Rng) = 0 Then
AnalizarCamino = 4
GoTo salida
End If
End If
salida:
Set Rng = Nothing
End Function
|
Finalmente, creamos un botón de formulario en el menú “programador” dentro de la hoja “juego” y le asignamos la macro “Inicio”, que es una de las cuatro macros que generan los módulos diseñados.
De esta forma, cada vez que seleccionamos un nivel de dificultad y pulsamos el botón de inicio se genera un nuevo juego aleatorio con nuestras palabras de búsqueda.
Es importante resaltar que las palabras buscadas sólo aparecen de forma aleatoria en sentido horizontal o vertical y de izquierda a derecha o derecha a izquierda. Es decir que no contempla palabras dispuestas en las diagonales.
Para jugar deberemos seleccionar la palabra una vez encontrada, y así un cartel nos indicará si la palabra es correcta, en cuyo caso quedará sombreada de color azul, o bien incorrecta y deberemos volver a intentarlo.
Te recomiendo ver el siguiente link con más videos de Tutoriales esenciales de Excel AQUÍ.
Salvo aclaración, todas las fórmulas y macros de este sitio están configuradas para aplicarse sobre la celda A1. Algunas fórmulas se encuentran encerradas entre llaves {} debido a que son fórmulas matriciales. Estas llaves no deben introducirse tecleándolas, sino que se generan automáticamente al aceptar la fórmula pulsando Control+Shift+Enter al mismo tiempo. Las fórmulas de este sitio son compatibles con versiones de Microsoft Excel® 2010 o superiores.