Sopa de Letras en EXCEL 2007, una macro para resolverlas
Hoy se me ocurrió la posibilidad de resolver una sopa de letras en excel (o sea "RESOLVER" " NO ARMARLA"). Busque en varios sitios web y en ninguno encontré nada similar a lo que me imagine. Y mi pregunta seria, ¿Alguien tiene idea de como hacer una macro que empiece a buscar desde una celda cualquiera y busque hacia arriba, hacia abajo, derecha, izquierda, en diagonal, de derecho o de revés?
1 respuesta
Este es un ejemplo de cómo debes poner la Sopa de Letras.
Te anexo la macro para resolver la SOPA DE LETRAS.
Sub sopa_de_letras()
'Por.Dante Amor
Set r = Range("C3").Resize(14, 14)
r.Interior.ColorIndex = xlNone
For i = 3 To Range("A" & Rows.Count).End(xlUp).Row
Set b = r.Find(Left(Cells(i, "A"), 1), lookat:=xlWhole)
If Not b Is Nothing Then
ncell = b.Address
Do
For k = 1 To 8
resto = Mid(Cells(i, "A"), 2, Len(Cells(i, "A")))
If busca(r, resto, k, b.Row, b.Column, False) Then
pintar = busca(r, resto, k, b.Row, b.Column, True)
Exit Do
End If
Next
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> ncell
End If
Next
End Sub
Function busca(r, resto, k, f, c, si)
'por.Dante Amor
For i = 1 To IIf(si, Len(resto) + 1, Len(resto))
If si Then Cells(f, c).Interior.ColorIndex = 4
Select Case k
Case 1: f = f - 1: c = c + 0
Case 2: f = f - 1: c = c + 1
Case 3: f = f + 0: c = c + 1
Case 4: f = f + 1: c = c + 1
Case 5: f = f + 1: c = c + 0
Case 6: f = f + 1: c = c - 1
Case 7: f = f + 0: c = c - 1
Case 8: f = f - 1: c = c - 1
End Select
If f >= r.Rows(1).Row And f <= r.Rows(r.Rows.Count).Row _
And c >= r.Columns(1).Column And c <= r.Columns(r.Columns.Count).Column Then
If Cells(f, c) = Mid(resto, i, 1) Then
continua = True
Else
continua = False
Exit For
End If
Else
continua = False
Exit For
End If
Next
busca = continua
End FunctionFuncionamiento:
1. La lista de palabras a buscar debe estar en la columna A, iniciando en la fila 3.
2. Deberás prellenar el cuadro de letras, iniciando en la celda C3.
3. El largo y ancho del cuadro de la sopa de letras lo podrás modificar en esta línea de la macro:
Set r = Range("C3").Resize(14, 14)
En el ejemplo, la tabla es de 14 filas por 14 columnas.
4. La macro realiza 8 búsquedas:
- De abajo hacia arriba
- De izquierda a derecha
- De arriba hacia abajo
- De derecha a izquierda
- Diagonal de izquierda a derecha y de abajo hacia arriba
- Diagonal de izquierda a derecha y de arriba hacia abajo
- Diagonal de derecha a izquierda y de arriba hacia abajo
- Diagonal de derecha a izquierda y de abajo hacia arriba
5. Si encuentra la palabra dentro de la sopa de letras la pondrá de color, puedes cambiar el color en esta línea de la macro
If si Then Cells(f, c).Interior.ColorIndex = 4
Por ejemplo, si utilizas el 6 se pintarán de amarillo
Saludos. Dante Amor
No olvides valorar la respuesta.
¡Gracias! Dante muy divertida la (sopa) y perdón por ponerte a la tarea de haberla echo por mi, la verdad es que yo recién estoy descubriendo las bondades de EXCEL y VBA y son realmente magnificas en mi caso hasta ahora solo había grabado macros y nunca desarrolle ninguna, tu conocimiento es digno de admirar eternamente agradecido 1000 puntos por tu ayuda
