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

Respuesta
4

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 Function


Funcionamiento:

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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas