Eliminar filas con elementos duplicados

01/09/2008 - 19:15 por Ricardo | Informe spam

Hola tengo el siguiente problema, tengo un libro de excel con elementos
repetidos, encontre dos codigos pero se me hace que solo funciona con pocas
lineas.

Ya que nada mas eliminan algunas.

Espero me puedan ayudar, les dejo los codigos, gracias

' Desactivar la actualización de pantalla para acelerar la macro.
Application.ScreenUpdating = False

' Obtener un recuento de los registros en los que buscar.
iListCount = Sheets("Indicadores Internas").Range("C6:C1000").Rows.Count
Sheets("Indicadores Internas").Range("A6:AH1000").Select ' Recorrer en bucle
hasta el final de los registros.
Do Until ActiveCell = "" ' Recorrer en bucle los registros.
For iCtr = 1 To iListCount ' No comparar contra sí mismo. ' Para especificar
una columna diferente, cambie el valor 1 en el número de columna.
If ActiveCell.Row <> Sheets("Indicadores Internas").Cells(iCtr, 1).Row Then
' Comparar el registro siguiente.
If ActiveCell.Value = Sheets("Indicadores Internas").Cells(iCtr, 1).Value
Then ' Si la coincidencia es verdad, eliminar la fila.
Sheets("Indicadores Internas").Cells(iCtr, 1).Delete xlShiftUp ' Contador de
incrementos para contar la fila eliminada.
iCtr = iCtr + 1
End If
End If
Next iCtr ' Ir al registro siguiente.
ActiveCell.Offset(1, 0).Select
Loop
Application.ScreenUpdating = True
MsgBox "Listo!"
End Sub

______________________________________________________________

Sub borrar_menos1()
Dim a() As String, rng As Range, str As String, i As Long, r As Range
Set rng = Range("C6", Range("C65536").End(xlUp))
start:
For Each r In rng
If Application.CountIf(Range("C6:C" & r.Row), r) > 1 Then
i = i + 1
ReDim Preserve a(1 To i)
a(i) = r.Address(0, 0)
If i = 50 Then
str = Join(C, ",")
Range(str).EntireRow.Delete
i = 0
Erase C
GoTo start
End If
End If
Next
str = Join(C, ",")
If str <> "" Then
Range(str).EntireRow.Delete
End If
Erase C
End Sub
_____________________________________________________

Siga el debate

9 respuestas

Tengo una respuesta

Preguntas similare

Eliminar filas con valores duplicados

Leer las respuestas

#6 mis_pistolas

02/09/2008 - 17:56 | Informe spam

On 2 sep, 10:36, wrote:

On 2 sep, 10:20, "Héctor Miguel"
wrote:

> hola, Ricardo !

> > ... ya funciona bien, pero has de cuenta que tengo varios datos desde la columna A hasta AH
> > ahora paraeliminarlos elementos duplicados me quiero guiar por la columna C
> > (que de esa columna vea cuales son los que se repiten y que solo deje un solo valor
> > ya que me toma de la columna A y si lo hace pero no como lo que yo quiero)
> > ME deberia de dejar en total cerca de 10 valores y me deja 5 que son los datos que se repiten en la columna A
> > y yo los que necesito son de la columna C, como le puedo hacer...

> del codigo que expusiste originalmente, hay una indicacion que precisa cual es la columna donde se ejecuta el bucle...
> _____

> > ' Para especificar una columna diferente, cambie el valor 1 en el numero de columna.

> y que significa que el 1 corresponde a la columna A en todas las instrucciones que hacen referencia a Cells(iCtr, 1)
> por lo que si deseas que sea la columna C, cambia ese numero en todas las instrucciones a: -> .Cells(iCtr, 3)
> _____

> > For iCtr = 1 To iListCount ' No comparar contra si mismo.
> > If ActiveCell.Row <> Sheets("Indicadores Internas").Cells(iCtr, 1).Row Then
> > ' Comparar el registro siguiente.
> > If ActiveCell.Value = Sheets("Indicadores Internas").Cells(iCtr, 1).Value
> > Then ' Si la coincidencia es verdad,eliminarla fila.
> > Sheets("Indicadores Internas").Cells(iCtr, 1).Delete xlShiftUp ' Contador de incrementos para contar la fila eliminada.

> saludos,
> hector.

Saludos Hector, diras que como doy lata, ya hice la modificacion en
los tres .Cells(Ictr,1).Rox que vienen en el codigo, cambie los 1 por
3, ejecuto la macro pero no borra los registros se queda penasndo un
rato y ya me despliega la ventana que dice "listo" pero no mas a que
crees que se deba.

Gracias
y disculpa- Ocultar texto de la cita -

- Mostrar texto de la cita -

tengo ya mi codigo de esta manera:

Sub DelDups_OneList()
Dim iListCount As Integer
Dim iCtr As Integer

' Turn off screen updating to speed up macro.
Application.ScreenUpdating = False

' Get count of records to search through.
iListCount = Sheets("Indicadores
Internas").Range("A6:AH600").Rows.Count
Sheets("Indicadores Internas").Range("A6:AH600").Select
' Loop until end of records.
Do Until ActiveCell = ""
' Loop through records.
For iCtr = 1 To iListCount
' Don't compare against yourself.
' To specify a different column, change 1 to the column number.
If ActiveCell.Row <> Sheets("Indicadores Internas").Cells(iCtr,
3).Row Then
' Do comparison of next record.
If ActiveCell.Value = Sheets("Indicadores
Internas").Cells(iCtr, 3).Value Then
' If match is true then delete row.
Sheets("Indicadores Internas").Cells(iCtr, 3).Delete
xlShiftUp
' Increment counter to account for deleted row.
iCtr = iCtr - 1
End If
End If
Next iCtr
' Go to next record.
ActiveCell.Offset(1, 0).Select
Loop
Application.ScreenUpdating = True
MsgBox "Listo!"
End Sub

Responder a este mensaje

#7 Héctor Miguel

02/09/2008 - 21:29 | Informe spam

hola, Ricardo !

(la verdad es que) existen varias formas (dependiendo de necesidades especificas)

la macro de la op1 es (o debiera ser) +/- rapidita, con alguna que otra (des)ventaja como:
- no es relevante si los datos estan ordenados o no
- puedes modificar un solo dato para la columna o fila de partida
- la funcion de hoja de calculo contar.si no toma en cuenta si son mayusculas/minusculas
- PERO... el rango resultante no puede exceder de 2,048 rangos no-contiguos -?-

la macro de la op2 utiliza los filtros avanzados por codigo (lo que debiera resultar en mayor rapidez)
OJO: asume titulos en la fila 5, los datos en columna C y usa como criterios el rango AJ5:AJ6
esta parte deberas adaptarla ya que no se puede ver el porque haces referencia al rango [A6:AH600] -???-

si cualquier duda (o informacion adicional)... comentas?
saludos,
hector.

en un modulo de codigo estandar/general/normal ==
Sub Eliminar_Repetidos()
Dim Repetidos As Range, Col As String, F1 As Long, Fx As Long, Fila As Long
Col = "c"
F1 = 6
Fx = Range(Range(Col & F1), Range(Col & "65536").End(xlUp)).Rows.Count
For Fila = F1 To Fx + F1 - 1
If Application.CountIf(Range(Col & F1 & ":" & Col & Fila), Range(Col & Fila)) > 1 Then
Set Repetidos = Union(Iif(Repetidos Is Nothing, Range(Col & Fila), Repetidos), Range(Col & Fila))
End If
Next
If Repetidos Is Nothing Then Exit Sub
Repetidos.EntireRow.Delete
ActiveSheet.UsedRange
Set Repetidos = Nothing
End Sub

Sub Elimina_Duplicados()
Application.ScreenUpdating = False
Range("aj6").Formula = _
"=sumproduct(--(($c$6:c6)=(c6)))>1"
With Range("a5").CurrentRegion
.AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Range("aj5:aj6")
.Offset(1).Resize(.Rows.Count - 1).EntireRow.Delete
End With
ActiveSheet.ShowAllData
Range("aj6").ClearContents
ActiveSheet.UsedRange
End Sub

Responder a este mensaje

#8 Ricardo_TS

04/09/2008 - 15:31 | Informe spam

On 2 sep, 14:29, "Héctor Miguel"
wrote:

hola, Ricardo !

(la verdad es que) existen varias formas (dependiendo de necesidades especificas)

la macro de la op1 es (o debiera ser) +/- rapidita, con alguna que otra (des)ventaja como:
- no es relevante si los datos estan ordenados o no
- puedes modificar un solo dato para la columna o fila de partida
- la funcion de hoja de calculo contar.si no toma en cuenta si son mayusculas/minusculas
- PERO... el rango resultante no puede exceder de 2,048 rangos no-contiguos -?-

la macro de la op2 utiliza los filtros avanzados por codigo (lo que debiera resultar en mayor rapidez)
OJO: asume titulos en la fila 5, los datos en columna C y usa como criterios el rango AJ5:AJ6
esta parte deberas adaptarla ya que no se puede ver el porque haces referencia al rango [A6:AH600] -???-

si cualquier duda (o informacion adicional)... comentas?
saludos,
hector.

en un modulo de codigo estandar/general/normal ==>
Sub Eliminar_Repetidos()
Dim Repetidos As Range, Col As String, F1 As Long, Fx As Long, Fila As Long
Col = "c"
F1 = 6
Fx = Range(Range(Col & F1), Range(Col & "65536").End(xlUp)).Rows.Count
For Fila = F1 To Fx + F1 - 1
If Application.CountIf(Range(Col & F1 & ":" & Col & Fila), Range(Col & Fila)) > 1 Then
Set Repetidos = Union(Iif(Repetidos Is Nothing, Range(Col & Fila), Repetidos), Range(Col & Fila))
End If
Next
If Repetidos Is Nothing Then Exit Sub
Repetidos.EntireRow.Delete
ActiveSheet.UsedRange
Set Repetidos = Nothing
End Sub

Sub Elimina_Duplicados()
Application.ScreenUpdating = False
Range("aj6").Formula = _
"=sumproduct(--(($c$6:c6)=(c6)))>1"
With Range("a5").CurrentRegion
.AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Range("aj5:aj6")
.Offset(1).Resize(.Rows.Count - 1).EntireRow.Delete
End With
ActiveSheet.ShowAllData
Range("aj6").ClearContents
ActiveSheet.UsedRange
End Sub

una disculpa hector, es que no habia visto tu mensaje:P

Prometo probar los codigos y ya te aviso como me funcionaron
Gracias

Responder a este mensaje

#9 Ricardo_TS

04/09/2008 - 16:02 | Informe spam

On 4 sep, 08:31, Ricardo_TS wrote:

On 2 sep, 14:29, "Héctor Miguel"
wrote:

> hola, Ricardo !

> (la verdad es que) existen varias formas (dependiendo de necesidades especificas)

> la macro de la op1 es (o debiera ser) +/- rapidita, con alguna que otra (des)ventaja como:
> - no es relevante si los datos estan ordenados o no
> - puedes modificar un solo dato para la columna o fila de partida
> - la funcion de hoja de calculo contar.si no toma en cuenta si son mayusculas/minusculas
> - PERO... el rango resultante no puede exceder de 2,048 rangos no-contiguos -?-

> la macro de la op2 utiliza los filtros avanzados por codigo (lo que debiera resultar en mayor rapidez)
> OJO: asume titulos en la fila 5, los datos en columna C y usa como criterios el rango AJ5:AJ6
> esta parte deberas adaptarla ya que no se puede ver el porque haces referencia al rango [A6:AH600] -???-

> si cualquier duda (o informacion adicional)... comentas?
> saludos,
> hector.

> en un modulo de codigo estandar/general/normal ==>
> Sub Eliminar_Repetidos()
> Dim Repetidos As Range, Col As String, F1 As Long, Fx As Long, Fila As Long
> Col = "c"
> F1 = 6
> Fx = Range(Range(Col & F1), Range(Col & "65536").End(xlUp)).Rows.Count
> For Fila = F1 To Fx + F1 - 1
> If Application.CountIf(Range(Col & F1 & ":" & Col & Fila), Range(Col & Fila)) > 1 Then
> Set Repetidos = Union(Iif(Repetidos Is Nothing, Range(Col & Fila), Repetidos), Range(Col & Fila))
> End If
> Next
> If Repetidos Is Nothing Then Exit Sub
> Repetidos.EntireRow.Delete
> ActiveSheet.UsedRange
> Set Repetidos = Nothing
> End Sub

> Sub Elimina_Duplicados()
> Application.ScreenUpdating = False
> Range("aj6").Formula = _
> "=sumproduct(--(($c$6:c6)=(c6)))>1"
> With Range("a5").CurrentRegion
> .AdvancedFilter _
> Action:=xlFilterInPlace, _
> CriteriaRange:=Range("aj5:aj6")
> .Offset(1).Resize(.Rows.Count - 1).EntireRow.Delete
> End With
> ActiveSheet.ShowAllData
> Range("aj6").ClearContents
> ActiveSheet.UsedRange
> End Sub

una disculpa hector, es que no habia visto tu mensaje:P

Prometo probar los codigos y ya te aviso como me funcionaron
Gracias- Ocultar texto de la cita -

- Mostrar texto de la cita -