Marcar celdas que tienen el mismo valor

Lo que deseo es poder marcas las celdas o filas que tengan en otra celda y fila el mismo valor, idealmente dentro del mismo mes, y sin que se duplique, ejemplo:

En imagen se marcaría el e4567 con el d24 porque son del mismo mes, y el e4569 con el d25 porque también son del mismo mes.

Además sería ideal que se ingrese en la última columna el dato de la columna 2 que corresponde al correlativo correspondiente a su par, o con el que se cruzó el dato.

Respuesta
2

Asumiendo que tienes los encabezados en la fila 1. Y la primer fecha empieza en la celda A2, prueba la siguiente macro:

Sub Marcar_Celdas()
'Por.Dante Amor
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, u As Long
  Dim r As Range
  '
  u = Range("A" & Rows.Count).End(3).Row
  Range("A1:D" & Rows.Count).Interior.Color = xlNone
  Range("E2:E" & Rows.Count) = ""
  a = Range("A2:D" & u).Value2
  ReDim b(1 To UBound(a), 1 To 1)
  Set r = Range("B" & u + 1 & ":D" & u + 1)
  '
  For i = 1 To UBound(a, 1)
    For j = i + 1 To UBound(a, 1)
      If Month(a(i, 1)) = Month(a(j, 1)) And a(i, 3) = a(j, 4) And a(i, 4) = a(j, 3) Then
        b(i, 1) = a(j, 2)
        b(j, 1) = a(i, 2)
        Set r = Union(r, Range("B" & i + 1).Resize(1, 3), Range("B" & j + 1).Resize(1, 3))
        Exit For
      End If
    Next
  Next
  '
  r.Interior.Color = vbYellow
  Range("B" & u + 1 & ":D" & u + 1).Interior.Color = xlNone
  Range("E2").Resize(UBound(a, 1)).Value = b
End Sub

Para las siguientes consultas, procura poner la imagen completa de la hoja, donde se muestren las filas y las columnas:

Hola Dante

Muchas gracias, como lo mencionaste, adjunto foto con mayor detalle, porque me da error por el tema del mes, si me puedes ayudar por favor!

Los encabezados siempre estarán ahí, en fila 8, lo otro es que las fechas vienen en formato texto, y los estoy pasando a fecha luego de importar los datos.

Gracias de antemano! 

Por alguna razón el foro no me envió el aviso de tu respuesta.

Anexo la macro ajustada a los datos de tu imagen

Sub Marcar_Celdas()
'Por.Dante Amor
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, u As Long
  Dim r As Range
  '
  u = Range("A" & Rows.Count).End(3).Row
  Range("A16:I" & u).Interior.Color = xlNone
  Range("E16:E" & u) = ""
  a = Range("A16:G" & u).Value2
  ReDim b(1 To UBound(a), 1 To 1)
  Set r = Range("A" & u + 1 & ":I" & u + 1)
  '
  For i = 1 To UBound(a, 1)
    For j = i + 1 To UBound(a, 1)
      If Month(a(i, 1)) = Month(a(j, 1)) And _
         a(i, 6) = a(j, 7) And a(i, 7) = a(j, 6) Then
          b(i, 1) = a(j, 3)
          b(j, 1) = a(i, 3)
          Set r = Union(r, Range("A" & i + 15).Resize(1, 9), Range("A" & j + 15).Resize(1, 9))
          Exit For
      End If
    Next
  Next
  '
  r.Interior.Color = vbYellow
  Range("A" & u + 1 & ":I" & u + 1).Interior.Color = xlNone
  Range("I16").Resize(UBound(a, 1)).Value = b
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas