Macro que elimine los registros repetidos de una tabla y solo deje el más reciente según fecha
Me gustaría que me pudieras ayudar con la siguiente macro. Tengo una hoja llamada "CLIENTES" y en ella tengo datos desde la fila 2 en adelante y desde la columna "A" hasta la columna "T".
En la columna "A" tengo la fecha en la cual se registró la fila, ejemplo 03-sep-2015.
Y en la columna "C" los códigos que deseo verificar cuales están repetidos.
Lo que deseo es una macro que revise los Códigos de la columna "C" y si encuentra repetidos, deje el último código más reciente en fecha y elimine las filas de los mismos códigos pero anteriores en fecha.
Ejemplo:
01-ene-2014 09345345
05-may-2014 09345345
12-dic-2014 09345345
La macro debería dejar en la base de datos el correspondiente al 12-dic-2014 y los anteriores es decir el del 01-ene-2014 y el del 05-may-2014 borrar sus correspondientes filas.
1 respuesta
H o l a:
Para eliminar los duplicados es preciso ordenar los datos por código y por fecha; entonces la macro ordenará los datos y después eliminará los duplicados. Al finalizar la macro puedes ordenar nuevamente los datos por la columna que necesites.
Sub EliminarDuplicados()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("CLIENTES")
u = h1.Range("C" & Rows.Count).End(xlUp).Row
'
With h1.Sort
.SortFields.Clear: .SortFields.Add Key:=h1.Range("C2:C" & u)
.SortFields.Add Key:=h1.Range("A2:A" & u)
.SetRange h1.Range("A1:T" & u): .Header = xlYes: .Apply
End With
'
ant = ""
For i = u To 2 Step -1
If ant = h1.Cells(i, "C") Then
h1.Rows(i).Delete
End If
ant = h1.Cells(i, "C")
Next
Application.ScreenUpdating = True
MsgBox "Se eliminaron los duplicados", vbInformation
End Sub
¡Gracias!
Pero al parecer no es muy conveniente en mi caso hacerlo, pues la puse a ejecutar y como tengo una base de datos de 5000 (Cinco mil registros) lleva ya como 5 minutos ejecutándose y aún no ha acabado, perece que mejor voy a realizarte otra sugerencia en otra pregunta para otra macro que haga mas o menos lo mismo pero uno a uno es decir actualizando cada código según la necesidad.
H o l a:
Le hice un cambio a la macro, en la columna Z te va a poner a los registros duplicados la palabra: "Borrar", los registros únicos estarán vacíos.
Prueba si de esa forma es más rápida la macro, por último filtra la columna Z y elimina los que dicen "Borrar" o filtra por vacío y copia esos registros a una nueva hoja.
Sub EliminarDuplicados()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("CLIENTES")
u = h1.Range("C" & Rows.Count).End(xlUp).Row
'
With h1.Sort
.SortFields.Clear: .SortFields.Add Key:=h1.Range("C2:C" & u)
.SortFields.Add Key:=h1.Range("A2:A" & u)
.SetRange h1.Range("A1:T" & u): .Header = xlYes: .Apply
End With
'
ant = ""
For i = u To 2 Step -1
If ant = h1.Cells(i, "C") Then
h1.Cells(i, "Z") = "Borrar"
End If
ant = h1.Cells(i, "C")
Next
Application.ScreenUpdating = True
MsgBox "Se eliminaron los duplicados", vbInformation
End Subs a l u d o s
