buscar coincidencias en sopa de letras en forma diagonal hacia abajo

[jhon666]

bueno tengo un gran problema y no lo he podido solucionar
tengo una hoja de excel al cual trae cada celda una cifra y necesito que busque dos coincidencias de un numero de 4 cifras pero en forma diagonal y las resalte de cualquier color sera esto posible es como si fuera a buscar en sopa de letras pero la busqueda tiene que ser en diagonal de arriba hacia abajo y de izquierda a derecha le agradeceria mucho me colaboraran

[PalitroqueZ]

si es posible, pero debes especificar bien el problema,

cuando dices coincidencia, ¿es respecto a los numeros que se encuentran en la misma diagonal o el resto de los numeros de la hoja también se incluyen?

[jhon666]

la idea es colocar un numero de 4 cifras en la celda A1 o si lo deseas puedes dividirlo en 4 celdas por ejemplo
   A1  o  A1 B1 C1 D1
1234       1  2   3   4
luego a  partir de la celda E1  estan los numeros asi

  3   5   7   9               
   8   2   6   0            
      0   8   6   4         
         8   4   0   6      
            2   4   6   8   
               6   0   4   8
                  6   4   2
                     0   6
                        6
la idea es buscar las 6 coincidencias posibles como son las dos primeras, las dos ultimas, la primera y la tercera,la primera y la cuarta,la segunda y la ultima,la segunda y la tercera y la resalte con un color como lo dije anteriormente en forma horizontal y diagonalmente de arriba hacia abajo y de izquierda a derecha solo esos dos metodos     
el rango es ("E1;CE26")
Tengo esta macro que me busca las dos coincidencias pero celda por celda tal vez te sirva de base para que me ayudes
Sub coincidencias()

Dim n As Range
Dim lookup

'se solicita ingreso del nro de 4 dígitos
lookup = Format(Val(InputBox("ingrese NUMERO de referencia", "BUSQUEDA DE COINCIDENCIAS")), "0000")
If Len(lookup) <> 4 Then
    MsgBox "Número no válido.", , "ERROR"
    Exit Sub
End If
'se guarda en AH1 y se da formato a la celda
With [AH1]
    .Value = lookup
    .NumberFormat = "0000"
    .Font.Bold = True
    .HorizontalAlignment = xlLeft
    .Interior.ColorIndex = 44     '(naranja)
End With
'se recorre el rango buscando las 6 coincidencias
'se limpia la col AG
Columns("AG:AG").Clear
x = 2
For Each n In Range("A1:AE44")
    If n = lookup Or Left(n.Value, 2) = Left(lookup, 2) Or Right(n.Value, 2) = Right(lookup, 2) Or _
        (Left(n.Value, 1) = Left(lookup, 1) And Right(n.Value, 1) = Right(lookup, 1)) Or _
        (Left(n.Value, 1) = Left(lookup, 1) And Mid(n.Value, 3, 1) = Mid(lookup, 3, 1)) Or _
        (Mid(n.Value, 2, 1) = Mid(lookup, 2, 1) And Right(n.Value, 1) = Right(lookup, 1)) Or _
        (Mid(n.Value, 2, 1) = Mid(lookup, 2, 1) And Mid(n.Value, 3, 1) = Mid(lookup, 3, 1)) Then
            n.Interior.ColorIndex = 4
            'se agrega el nro a la col AG
            Range("AG" & x) = n
            x = x + 1
       
    Else   'opcional quitar color a los no coincidentes.
        n.Interior.Color = xlNone
    End If
Next n
MsgBox "Fin del proceso.", , "INFORMACIÓN"
End Sub
y en internet he encontrado esta macro pero busca es todo el numero completo como en una sopa de letras y no las coincidencias
Sub sopa_de_letras()
'Por.Dante Amor
    Set r = Range("C3").Resize(40, 50)
    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 2
                    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 + 0: c = c + 1
                         Case 2:: 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
muchas gracias por la colaboracion espero que me ayudes