Sopa de letras pero con números

Para dante

Quisiera cambiar el código que en ves de buscar palabras buscara números en una 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

Añade tu respuesta

Haz clic para o