Copiar elementos no repetidos
Buenas, Mr. Valedor.
Aquí estoy de nuevo con una duda que me tiene bloqueado. Tengo una lista (columna) de clientes y localidad a la que pertenecen. Estas localidades pueden estar repetidas (por ej. El cliente A puede ser de Localidad1, y el cliente B de Localidad1 también). Mi intención es poner en una hoja aparte (en una columna), las localidades de tal forma que no se repitan, es decir, que no me salgan Localidad1, Localidad1, Localidad2,..., sino que solo salgan Localidad1, Localidad2, ... LocalidadN.
He probado buscando una función, y no la encuentro. ¿Es posible hacer esto con un macro o con código VBA?.
Miles de gracias, por tu inestimable colaboración.
Dr. Dudas.
Aquí estoy de nuevo con una duda que me tiene bloqueado. Tengo una lista (columna) de clientes y localidad a la que pertenecen. Estas localidades pueden estar repetidas (por ej. El cliente A puede ser de Localidad1, y el cliente B de Localidad1 también). Mi intención es poner en una hoja aparte (en una columna), las localidades de tal forma que no se repitan, es decir, que no me salgan Localidad1, Localidad1, Localidad2,..., sino que solo salgan Localidad1, Localidad2, ... LocalidadN.
He probado buscando una función, y no la encuentro. ¿Es posible hacer esto con un macro o con código VBA?.
Miles de gracias, por tu inestimable colaboración.
Dr. Dudas.
Respuesta de valedor
1
Copia todas las localidades a una hoja nueva, deja el cursor dentro de estos datos, y ejecuta la siguiente macro
Public Sub SoloUnicos()
Dim co1 As Integer
'Esto es para que se más 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 método 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).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
Hay más formas, sobre todo cuando los datos son muchos más, pero esto es sencillo
Public Sub SoloUnicos()
Dim co1 As Integer
'Esto es para que se más 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 método 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).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
Hay más formas, sobre todo cuando los datos son muchos más, pero esto es sencillo
Estoy buscando la nota de 10, pero no la encuentro ;-)
Genial, como siempre. Perdón por la demora en la valoración de la respuesta, pero estaba de mini-vacaciones navideñas. Por cierto Feliz Navidad y próspero y EXCELente 2.002
Genial, como siempre. Perdón por la demora en la valoración de la respuesta, pero estaba de mini-vacaciones navideñas. Por cierto Feliz Navidad y próspero y EXCELente 2.002
