eliminar

Tendrás que recurrir a una macro para esa tarea.
En principio no especificas cuantos campos tienen los registros.
Tampoco indicas si deseas utilizar TODOS los campos como criterio de
comparación.

Te adjunto una macro general que ELIMINA de la tabla señalada,
aquellos registros (líneas) que NO están duplicadas.
Importante: la celda o CELDAS ACTIVAS indicarán el campo/s que toma
la macro como criterio de comparación (campos de comparación)

Ejemplo: Si la tabla empieza en celda A1, y la columna a comparar es
la columna A, sólo tienes que 'pinchar' con el ratón en la tabla,
columna A, y ejecutar la macro.

Los registros (líneas) no repetidos, quedarán eliminados, sin que sea
posible DESHACER la acción -se recomienda trabajar con una copia de
la tabla-
El resultado se muestra ordenado por el/los campo/s de comparación.

Espero te sirva,
Saludos,




Sub Solo_RepetidosX2()
'
'*************************************************************
' Borra aquellas filas de la REGION ACTUAL cuyo RANGO clave se
encuentre repetido.
' RANGO CLAVE: el rango actual. (Varias celdas consecutivas).
'*************************************************************
'
Dim mensaje1 As String, Respuesta As Integer
Dim contador As Integer
Dim igual As Boolean, igualantes As Boolean, cont As Integer, final
As Integer
Dim claves As Range, tabla As Range, c As Range, d As Range, e As
Range
Dim rango_claves As Range

mensaje1 = "De la región actual se eliminarán " & Chr(13) &
Chr(10) & _
"aquellas filas cuyo campo clave (celda activa)" & Chr(13) &
Chr(10) & _
"NO se encuentre repetido. (NO ADMITE 'DESHACER')"

'*************************************************************
' Comprobaciones previas.
'*************************************************************
'
Respuesta = MsgBox(Prompt:=mensaje1, Title:=" Sólo
Unicos", Buttons:e)
If Respuesta = 2 Then Exit Sub
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
'*************************************************************
' Tomamos medidas. Rango_claves: región a comparar.
'*************************************************************
'
Set claves = Selection
Set tabla = Selection.CurrentRegion
Set rango_claves = Range(Cells(tabla.Cells(1, 1).Row, _
claves.Cells(1, 1).Column), Cells(tabla.Cells(1, 1).Row +
tabla.Rows.Count - 1, _
claves.Cells(1, 1).Column + claves.Columns.Count - 1))
'
'*************************************************************
' Ordenamos la región actual de forma recursiva, desde última clave
hasta primera
'*************************************************************
'
For Each c In claves
tabla.Sort Key1:=c, Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom
Next c
'*************************************************************
' Bucle borrado líneas.
' Desde la 1ª fila hasta la (última-1)!!
'*************************************************************
'
cont = 1
igualantes = False
final = rango_claves.Rows.Count
For Each d In rango_claves.Rows
If cont <> final + 1 Then 'Ultima fila se salta.
' reseteamos el flag
igualantes = igual
igual = False
For Each e In d.Cells
If e.Value = e.Offset(1, 0).Value Then
igual = True
End If
Next e
' Borramos si no es igual a anterior ni a posterior
If igualantes = False And igual = False Then
tabla.Rows(d.Row - tabla.Row + 1).ClearContents
contador = contador + 1
End If
End If
cont = cont + 1
Next d
'*************************************************************
' Volvemos a ordenar la región.
'*************************************************************
'
For Each c In claves
tabla.Sort Key1:=c, Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom
Next c
claves.Select ' Salimos con la misma selección.
'
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox Prompt:="Se han eliminado " & contador & " líneas.",
Title:=" Sólo Unicos", Buttons:=0

End Sub

Te pasaste. Funciono a la perfeccion.-

Fdo
"bernalko_en_wanadoo" wrote in message
news:
Tendrás que recurrir a una macro para esa tarea.
En principio no especificas cuantos campos tienen los registros.
Tampoco indicas si deseas utilizar TODOS los campos como criterio de
comparación.

Te adjunto una macro general que ELIMINA de la tabla señalada,
aquellos registros (líneas) que NO están duplicadas.
Importante: la celda o CELDAS ACTIVAS indicarán el campo/s que toma
la macro como criterio de comparación (campos de comparación)

Ejemplo: Si la tabla empieza en celda A1, y la columna a comparar es
la columna A, sólo tienes que 'pinchar' con el ratón en la tabla,
columna A, y ejecutar la macro.

Los registros (líneas) no repetidos, quedarán eliminados, sin que sea
posible DESHACER la acción -se recomienda trabajar con una copia de
la tabla-
El resultado se muestra ordenado por el/los campo/s de comparación.

Espero te sirva,
Saludos,




Sub Solo_RepetidosX2()
'
'*************************************************************
' Borra aquellas filas de la REGION ACTUAL cuyo RANGO clave se
encuentre repetido.
' RANGO CLAVE: el rango actual. (Varias celdas consecutivas).
'*************************************************************
'
Dim mensaje1 As String, Respuesta As Integer
Dim contador As Integer
Dim igual As Boolean, igualantes As Boolean, cont As Integer, final
As Integer
Dim claves As Range, tabla As Range, c As Range, d As Range, e As
Range
Dim rango_claves As Range

mensaje1 = "De la región actual se eliminarán " & Chr(13) &
Chr(10) & _
"aquellas filas cuyo campo clave (celda activa)" & Chr(13) &
Chr(10) & _
"NO se encuentre repetido. (NO ADMITE 'DESHACER')"

'*************************************************************
' Comprobaciones previas.
'*************************************************************
'
Respuesta = MsgBox(Prompt:=mensaje1, Title:=" Sólo
Unicos", Buttons:e)
If Respuesta = 2 Then Exit Sub
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
'*************************************************************
' Tomamos medidas. Rango_claves: región a comparar.
'*************************************************************
'
Set claves = Selection
Set tabla = Selection.CurrentRegion
Set rango_claves = Range(Cells(tabla.Cells(1, 1).Row, _
claves.Cells(1, 1).Column), Cells(tabla.Cells(1, 1).Row +
tabla.Rows.Count - 1, _
claves.Cells(1, 1).Column + claves.Columns.Count - 1))
'
'*************************************************************
' Ordenamos la región actual de forma recursiva, desde última clave
hasta primera
'*************************************************************
'
For Each c In claves
tabla.Sort Key1:=c, Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom
Next c
'*************************************************************
' Bucle borrado líneas.
' Desde la 1ª fila hasta la (última-1)!!
'*************************************************************
'
cont = 1
igualantes = False
final = rango_claves.Rows.Count
For Each d In rango_claves.Rows
If cont <> final + 1 Then 'Ultima fila se salta.
' reseteamos el flag
igualantes = igual
igual = False
For Each e In d.Cells
If e.Value = e.Offset(1, 0).Value Then
igual = True
End If
Next e
' Borramos si no es igual a anterior ni a posterior
If igualantes = False And igual = False Then
tabla.Rows(d.Row - tabla.Row + 1).ClearContents
contador = contador + 1
End If
End If
cont = cont + 1
Next d
'*************************************************************
' Volvemos a ordenar la región.
'*************************************************************
'
For Each c In claves
tabla.Sort Key1:=c, Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom
Next c
claves.Select ' Salimos con la misma selección.
'
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox Prompt:="Se han eliminado " & contador & " líneas.",
Title:=" Sólo Unicos", Buttons:=0

End Sub