Featured Replies
Archivado
Este tema está ahora archivado y está cerrado a más respuestas.
A better way to browse. Learn more.
A full-screen app on your home screen with push notifications, badges and more.
Este tema está ahora archivado y está cerrado a más respuestas.
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