Eliminar registros repetidos
Buen día, tengo una BD en excel con más 5 mil registros pero muchos de ellos son direcciones REPETIDAS, ¿Cómo puedo eliminar los registros que están repetidos pero por dirección para hacer mi base más pequeña? Ejemplo:
num nombre dirección compras
1 juan coral 258 2
2 jose esmeralda 110 3
...
5000 miguel coral 258 2
5001 ramón esmeralda 110 3
Y otra pregunta, como puedo eliminar los numero del campo DIRECCIÓN, es decir:
num nombre dirección compras
1 juan coral 2
2 jose esmeralda 3
...
5000 miguel coral 2
5001 ramón esmeralda 3
Espero me puedan ayudar, de antemano muchas gracias
num nombre dirección compras
1 juan coral 258 2
2 jose esmeralda 110 3
...
5000 miguel coral 258 2
5001 ramón esmeralda 110 3
Y otra pregunta, como puedo eliminar los numero del campo DIRECCIÓN, es decir:
num nombre dirección compras
1 juan coral 2
2 jose esmeralda 3
...
5000 miguel coral 2
5001 ramón esmeralda 3
Espero me puedan ayudar, de antemano muchas gracias
1 respuesta
Respuesta de Cadipas spain
1
Creo que lo he resuelto con una macro, te la adjunto y si no sabes que hacer con ello, me lo indicas y te maco los pasos.
Mi consejos es que hagas a prueba con un fichero copia, parq ue no pierdas los datos.
'--------
Private Sub CommandButton1_Click() ' elimina numero de dirección
f = 2
Do While Cells(f, 3) <> ""
direccion = ""
For x = 1 To Len(Cells(f, 3))
If IsNumeric(Mid(Cells(f, 3), x, 1)) Then
Else
direccion = direccion & Mid(Cells(f, 3), x, 1)
End If
Next x
Cells(f, 3) = direccion
f = f + 1
Loop
borrar_repetidos
End Sub
Sub borrar_repetidos()
ultimafila = Range("c65500").End(xlUp).Row
For f = 2 To ultimafila
rango = "C" & f + 1 & ":C" & ultimafila
mas = True
Do While mas = True
With Range(rango)
If mas = True Then
Set c = .Find(Cells(f, 3), LookIn:=xlValues)
If Not c Is Nothing Then
Rows(c.Row).Delete Shift:=xlUp
ultimafila = ultimafila - 1
If ultimafila <= f Then End
Else
mas = False
End If
End If
End With
Loop
Next f
End Sub
'
Mi consejos es que hagas a prueba con un fichero copia, parq ue no pierdas los datos.
'--------
Private Sub CommandButton1_Click() ' elimina numero de dirección
f = 2
Do While Cells(f, 3) <> ""
direccion = ""
For x = 1 To Len(Cells(f, 3))
If IsNumeric(Mid(Cells(f, 3), x, 1)) Then
Else
direccion = direccion & Mid(Cells(f, 3), x, 1)
End If
Next x
Cells(f, 3) = direccion
f = f + 1
Loop
borrar_repetidos
End Sub
Sub borrar_repetidos()
ultimafila = Range("c65500").End(xlUp).Row
For f = 2 To ultimafila
rango = "C" & f + 1 & ":C" & ultimafila
mas = True
Do While mas = True
With Range(rango)
If mas = True Then
Set c = .Find(Cells(f, 3), LookIn:=xlValues)
If Not c Is Nothing Then
Rows(c.Row).Delete Shift:=xlUp
ultimafila = ultimafila - 1
If ultimafila <= f Then End
Else
mas = False
End If
End If
End With
Loop
Next f
End Sub
'
Hola que tal, mil disculpas por no responder de inmediato pero se me acumularon muchas actividades. Antes que nada muchas gracias por responder a mi pregunta se nota que dominas el excel, solo que hay una cuestión: Resulta que la macro me borra los números y después los duplicados, quiero saber si es posible hacerlo a la inversa, primero elimina los duplicados y después elimina los números y otra cosa, necesito eliminar los duplicados pero que me deje 1 original, es decir, si tengo 5 calles con el nombre "av. de la paz 550" que me elimine 4 registros y que me deje 1 para no desaparecerlo de la base, te envío un archivo de ejemplo para que me entiendas mejor, de antemano muchas gracias y saludos
Cambia las macros por estas otras, te hago saber que primero ordeno por dirección y luego borro lo repetido y paso a quitar los números de las direcciones.
Espero que te sirva se esta manera, si precisas cualquier otra aclaración o medificación no lo dudes.
Pero si das por terminada la cuestión, por favor cierra y valora la ayuda.
Saludos
'----------------
La macro nueva es la siguiente
'-----------------
Private Sub CommandButton1_Click() ' elimina numero de dirección
f = 2
Columns("A:D").Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Key2:=Range("B1") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
borrar_repetidos
Do While Cells(f, 3) <> ""
direccion = ""
For x = 1 To Len(Cells(f, 3))
If IsNumeric(Mid(Cells(f, 3), x, 1)) Then
Else
direccion = direccion & Mid(Cells(f, 3), x, 1)
End If
Next x
Cells(f, 3) = direccion
f = f + 1
Loop
End Sub
Sub borrar_repetidos()
ultimafila = Range("c65500").End(xlUp).Row
For f = 2 To ultimafila
rango = "C" & f + 1 & ":C" & ultimafila
If Cells(f, 3) = Cells(f + 1, 3) Then
Rows(f + 1).Delete Shift:=xlUp
ultimafila = ultimafila - 1
f = f - 1
If ultimafila <= f Then Exit Sub
End If
Next f
End Sub
Espero que te sirva se esta manera, si precisas cualquier otra aclaración o medificación no lo dudes.
Pero si das por terminada la cuestión, por favor cierra y valora la ayuda.
Saludos
'----------------
La macro nueva es la siguiente
'-----------------
Private Sub CommandButton1_Click() ' elimina numero de dirección
f = 2
Columns("A:D").Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Key2:=Range("B1") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
borrar_repetidos
Do While Cells(f, 3) <> ""
direccion = ""
For x = 1 To Len(Cells(f, 3))
If IsNumeric(Mid(Cells(f, 3), x, 1)) Then
Else
direccion = direccion & Mid(Cells(f, 3), x, 1)
End If
Next x
Cells(f, 3) = direccion
f = f + 1
Loop
End Sub
Sub borrar_repetidos()
ultimafila = Range("c65500").End(xlUp).Row
For f = 2 To ultimafila
rango = "C" & f + 1 & ":C" & ultimafila
If Cells(f, 3) = Cells(f + 1, 3) Then
Rows(f + 1).Delete Shift:=xlUp
ultimafila = ultimafila - 1
f = f - 1
If ultimafila <= f Then Exit Sub
End If
Next f
End Sub
