marcar celdas coincidentes entre cuadros

jhon fredy · el 19 de marzo

hola expertos buenas tardes mi idea es bordear aquellas celdas que su numero sea igual a su posicion en los cuadros tanto arriba como abajo como lo muestro en la imagen con las celdas rojas

Sub resaltar()
'
' Resaltar Macro
' Resalta similitudes  https://foro.todoexcel.com/threads/bordear-celdas-de-acuerdo-a-posicion.55559/#post-237370
'
' Acceso directo: CTRL+q
'
Sheets("Hoja2").Select
F1 = Asc(Range("A2").Value)
f2 = Asc(Range("A3").Value)
C1 = Range("B2").Value
C2 = Range("B3").Value
        
For J = 0 To 7 ' numero de Columnas
Debug.Print "Siguiente Fila "
If J Mod 2 = 0 Then
Debug.Print "Esta si la hago :" & J
    For i = 0 To 9 ' numero de filas
        Debug.Print Range(Chr(F1 + J) & C1 + i).Address & " : " & Range(Chr(F1 + J) & C1 + i).Value
        Debug.Print Range(Chr(F1 + J) & C2 + 9 - i).Address & ": " & Range(Chr(F1 + J) & C2 + 9 - i).Value
            If Range(Chr(F1 + J) & C1 + i).Value = Range(Chr(F1 + J) & C2 + 9 - i).Value Then
                 resaltarCelda (Sheets("Hoja2").Range(Chr(F1 + J) & C1 + i))
                 resaltarCelda (Sheets("Hoja2").Range(Chr(F1 + J) & C2 + 9 - i))
            End If
    Next i
Else
Debug.Print "Esta No la hago :" & J
End If
Next J

MsgBox "Proceso Terminado"

  End Sub


    Sub resaltarCelda(r As Range)
    r.Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    End Sub