Eliminar registros repetidos
Hola Valedor, ¿me puede ayudar con una rutina para eliminar las filas que contienen el numero de identificación repetido (registros únicos)? Se encuentran en la columna A, no lo puedo hacer por filtro avanzado por que existen datos como vendedor que lo atendió, fecha, etc... Datos que no me interesan, únicamente necesito extractar num de identificación nombre y sector económico... De antemano gracias
1 Respuesta
Respuesta de valedor
Pues sigo creyendo que el filtro avanzado funcionaria muy bien, pero los campos que no te sirvan tan solo elimínalos, el problemas son las filas, o sea los registros, para esto, alguien ya me pregunto esto, te propongo la busques en mis respuestas contestadas, si no la encuentras avisame...
Ya encontré la solución:
Public Sub SoloUnicos()
Dim co1 As Integer
'Esto es para que se mas rapido, si quieres ver como lo hace, solo comenta la linea siguiente, si tienes poco datos (menos de 1000) esto es suficiente, pero si son más hay que escoger otro metodo más rapido
'Application.ScreenUpdating = False
'Seleccionamos la region actual
ActiveCell.CurrentRegion.Select
'Si hay mas de una fila continuamos
If Selection.Rows.Count > 1 Then
'Ordenamos los datos
'Selection.Sort Key1:=ActiveCell, Order1:=xlAscending
'Selecciono la primer celda de los datos
Selection.Range("A1").Select
'Me detengo hasta que haya una celda vacia
Do While Trim(ActiveCell.Offset(1, 0).Value) <> ""
'Compruebo si la la celda y su adyacente inferiro son iguales
If Trim(ActiveCell.Value) = Trim(ActiveCell.Offset(1, 0).Value) Then
'Si son iguales borro la segunda
ActiveCell.Offset(co1, 0).EntireRow.Delete
Else
'Si no son iguales, me posiciono en la segunda
ActiveCell.Offset(1, 0).Select
End If
Loop
End If
'Reactivo la actualizacion de pantalla
Application.ScreenUpdating = True
End Sub
Public Sub SoloUnicos()
Dim co1 As Integer
'Esto es para que se mas rapido, si quieres ver como lo hace, solo comenta la linea siguiente, si tienes poco datos (menos de 1000) esto es suficiente, pero si son más hay que escoger otro metodo más rapido
'Application.ScreenUpdating = False
'Seleccionamos la region actual
ActiveCell.CurrentRegion.Select
'Si hay mas de una fila continuamos
If Selection.Rows.Count > 1 Then
'Ordenamos los datos
'Selection.Sort Key1:=ActiveCell, Order1:=xlAscending
'Selecciono la primer celda de los datos
Selection.Range("A1").Select
'Me detengo hasta que haya una celda vacia
Do While Trim(ActiveCell.Offset(1, 0).Value) <> ""
'Compruebo si la la celda y su adyacente inferiro son iguales
If Trim(ActiveCell.Value) = Trim(ActiveCell.Offset(1, 0).Value) Then
'Si son iguales borro la segunda
ActiveCell.Offset(co1, 0).EntireRow.Delete
Else
'Si no son iguales, me posiciono en la segunda
ActiveCell.Offset(1, 0).Select
End If
Loop
End If
'Reactivo la actualizacion de pantalla
Application.ScreenUpdating = True
End Sub
