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.
1 Respuesta
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 SubPara 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
