Excel - Busqueda y filtrado de duplicados con VBA

Busqueda y filtrado de duplicados con VBA

Publicado por Miguel (14 intervenciones) el 30/11/2021 15:17:16

Buen día, esta consulta esta relacionada a la que anteriormente hice en mi perfil.

El desafío sigue siendo el mismo,
Identificar los ID duplicados e ir filtrandolos, cortandolos y pegarlos en otra hoja hasta que no existan duplicados en una misma hoja de trabajo.

En una página me encontré con esta macro, que lo que hace es buscar los duplicados de la columna "A" y en la columna "E", me dice si es "duplicado" o esta "OK" (haciendo alusión a que es un registro único.

Yo manualmente fui filtrando los "OK", copié y pegué en otra hoja, luego volví a la hoja 1 y eliminé estas filas, repetí el proceso hasta que no quedaran mas "duplicados".

Básicamente sería que:
1) Chequeara si en la columna "A" hay duplicados, si sí los hay, que en la columna "E" me indique "duplicado", sino que diga "OK".
2) Que filtre los "OK" y los pegue en una hoja nueva,
3) Que vuelva a la hoja 1, elimine esos "OK" y repita la macro hasta que no existan duplicados en la hoja 1.

Mis nociones de VBA son vagas y no se como plasmar ese proceso que hago en un código.
Ahí es donde entran uds estimados!.

PD: El punto 1 ya esta realizado, el desafío es el punto 2 y 3.

Captura-de-pantalla-2021-11-30-110610

Dejo el archivo para que quede mas claro.

IDs-duplicados.rar(45,9 KB)

Valora esta pregunta

Me gusta: Está pregunta es útil y esta clara

No me gusta: Está pregunta no esta clara o no es útil

Responder

Pos: 2

Val: 4.908

Busqueda y filtrado de duplicados con VBA

Publicado por Antoni Masana (2540 intervenciones) el 30/11/2021 17:28:55

Este código hace lo siguiente:

- Cuenta el número de líneas
- Ordena por ID
- Compara el ID con el anterior, si son iguales los marca como DUPLICADO en caso contrario com OK
- Ordena por ESTADO dejando los duplicados los primeros.
- Cuenta el número de duplicados.
- Borra los duplicados.

Sub Duplicados_Quitar()

    Dim Fila As Long

    Application.ScreenUpdating = False

    Application.Calculation = xlCalculationManual

    Application.EnableEvents = False

    ActiveSheet.DisplayPageBreaks = False

    Fila = 2

    While Cells(Fila, "A") <> Empty

       Fila = Fila + 1

    Wend

    Fila = Fila - 1

    ' ---&--- Ordena por la columna A

    Columns("A:E").Select

    ActiveWorkbook.Worksheets("Hoja1").Sort.SortFields.Clear

    ActiveWorkbook.Worksheets("Hoja1").Sort.SortFields.Add2 _

                  Key:=Range("A2:A" & Fila), _

                  SortOn:=xlSortOnValues, _

                  Order:=xlAscending, _

                  DataOption:=xlSortNormal

    With ActiveWorkbook.Worksheets("Hoja1").Sort

        .SetRange Range("A1:E" & Fila)

        .Header = xlYes

        .MatchCase = False

        .Orientation = xlTopToBottom

        .SortMethod = xlPinYin

        .Apply

    End With

    ' ---&--- Busca duplicados

    Fila = 2

    While Cells(Fila, "A") <> Empty

       If Cells(Fila, "A") = Cells(Fila - 1, "A") Then

          Cells(Fila, "E") = "Duplicado"

       Else

          Cells(Fila, "E") = "OK"

       End If

       Fila = Fila + 1

    Wend

    Fila = Fila - 1

    ' ---&--- Ordena por la columna E

    Columns("A:E").Select

    ActiveWorkbook.Worksheets("Hoja1").Sort.SortFields.Clear

    ActiveWorkbook.Worksheets("Hoja1").Sort.SortFields.Add2 _

                  Key:=Range("E2:E" & Fila), _

                  SortOn:=xlSortOnValues, _

                  Order:=xlAscending, _

                  DataOption:=xlSortNormal

    With ActiveWorkbook.Worksheets("Hoja1").Sort

        .SetRange Range("A1:E" & Fila)

        .Header = xlYes

        .MatchCase = False

        .Orientation = xlTopToBottom

        .SortMethod = xlPinYin

        .Apply

    End With

    ' ---&--- Cuenta los duplicados

    Fila = 2

    While Cells(Fila, "E") = "Duplicado"

       Fila = Fila + 1

    Wend

    Fila = Fila - 1

    ' ---&--- Borra los Duplicados.

    If Fila = 1 Then

        MsgBox "No hay codigos duplicados"

    Else

        MsgBox "Duplicados desde la fila 2 hasta la fila " & Fila

        Rows("2:" & Fila).Select

        Selection.Delete Shift:=xlUp

    End If

    Application.ScreenUpdating = True

    Application.Calculation = xlCalculationAutomatic

    Application.EnableEvents = True

    ActiveSheet.DisplayPageBreaks = True

    Application.CutCopyMode = False

End Sub

Puedes ejecutar la macro tantas veces como quieras.

Saludos.
\\//_

Valora esta respuesta

Me gusta: Está respuesta es útil y esta clara

No me gusta: Está respuesta no esta clara o no es útil

Comentar

Busqueda y filtrado de duplicados con VBA

Publicado por Miguel (14 intervenciones) el 30/11/2021 17:49:06

Estimado, aprecio el trabajo de esa macro, pero no esta cumpliendo el cometido.
En resumen, esa macro lo que hace es filtrar los "duplicados" y los elimina.

Yo lo que traté de explicar arriba, es que yo necesito una macro que...
1) Analice si en la columna "A", hay duplicados y en la columna "E" me ponga "duplicado" en caso de SI u "OK" en caso de no.
2) Me filtre los "OK", seleccione esas celdas visibles, las copie y pegue en una nueva hoja.
3) Vuelva a la hoja 1, elimine esa selección de "OK", saque los filtros y repita la macro de análisis de duplicados.}

Necesito que repita el copiado y pegado de registros "Únicos o OK" en otra hoja, hasta que en mi hoja 1 no hayan duplicados.

Valora esta respuesta

Comentar

Pos: 2

Val: 4.908

Busqueda y filtrado de duplicados con VBA

Publicado por Antoni Masana (2540 intervenciones) el 30/11/2021 18:52:51

No entiendo la necesidad de copiar a otra hoja lo que ya tienes en una.
Es decir Busca los registros con ID duplicada los marca y los borra, a la macro solo se falta eliminar la columna E.
En la misma hoja tienes el resultado y de una sola pasada eliminas todos los duplicados.

Es más, a la macro anterior le sobra un montón de código, Excel sabe quitar duplicados:

Sub Duplicados_Quitar()

    Dim Fila As Long

    Application.ScreenUpdating = False

    Application.Calculation = xlCalculationManual

    Application.EnableEvents = False

    ActiveSheet.DisplayPageBreaks = False

    Fila = 2

    While Cells(Fila, "A") <> Empty

       Fila = Fila + 1

    Wend

    Fila = Fila - 1

    ' ---&--- Ordena por la columna A

    Columns("A:E").Select

    ActiveWorkbook.Worksheets("Hoja1").Sort.SortFields.Clear

    ActiveWorkbook.Worksheets("Hoja1").Sort.SortFields.Add2 _

                  Key:=Range("A2:A" & Fila), _

                  SortOn:=xlSortOnValues, _

                  Order:=xlAscending, _

                  DataOption:=xlSortNormal

    With ActiveWorkbook.Worksheets("Hoja1").Sort

        .SetRange Range("A1:E" & Fila)

        .Header = xlYes

        .MatchCase = False

        .Orientation = xlTopToBottom

        .SortMethod = xlPinYin

        .Apply

    End With

    ' ---&--- Quita duplicados

    ActiveSheet.Range("$A$1:$D$" & Fila).RemoveDuplicates _

                Columns:=1, _

                Header:=xlYes

    Application.ScreenUpdating = True

    Application.Calculation = xlCalculationAutomatic

    Application.EnableEvents = True

    ActiveSheet.DisplayPageBreaks = True

    Application.CutCopyMode = False

End Sub

Esta te lo deja limpio de duplicados en la columna A y no hace falta la columna E.

Saludos.
\\//_

Valora esta respuesta

Comentar

Busqueda y filtrado de duplicados con VBA

Publicado por Miguel (14 intervenciones) el 30/11/2021 20:04:08

La necesidad de copiarlos a otra hoja es que todos los registros deben ser cargados a una base externa, pero la misma no permite duplicados por hoja.
Por eso la manera mas fácil de conservarlos es separándolos en varias hojas.

Captura-de-pantalla-2021-11-30-160114

Ejemplo, en esta imagen de arriba, puede ver que los tres registros de la columna "A", están duplicados, pero tienen distinto código en la columna "B". Si yo subo este archivo a dicha web no me va a tomar los últimos dos registros porque están duplicados.
En cambio si separa los registros por hoja con su respectivo código y fechas si me permite la carga.

Valora esta respuesta

Comentar

Pos: 2

Val: 4.908

Busqueda y filtrado de duplicados con VBA

Publicado por Antoni Masana (2540 intervenciones) el 30/11/2021 20:45:27

Ahora lo entiendo.
Ha de haber tantas hojas como veces este el codigo que más se repita.

Por ejemplo estos ID

19314698
19636999
19891985
26782456

están 8 veces, que son los que más se repiten, el libro tiene que tener 8 hojas y un ID estos en cada hoja.
Si la lista fuesen estos 4 ID que están repetidos cada uno 8 veces, después de ejecutar la macro tendría 8 hoja con los 4 códigos en cada hoja.

Es fácil, mañana lo miro que ahora estoy espeso.

Saludos.
\\//_

Valora esta respuesta

Comentar

Busqueda y filtrado de duplicados con VBA

Publicado por Miguel (14 intervenciones) el 30/11/2021 20:47:15

Exactamente, en un archivo aparte llegue a tener 16 hojas.
Le agradezco su tiempo y quedo a la espera.

Valora esta respuesta

Comentar

Pos: 2

Val: 4.908

Busqueda y filtrado de duplicados con VBA

Publicado por Antoni Masana (2540 intervenciones) el 01/12/2021 17:13:41

Esta es la macro.

Sub Duplicados()

    Dim Filas() As Long, Hoja As Byte, Num_Hojas As Byte, Ultimo() As Long, _

        Nuevo As Boolean, a As Byte, ID As Long

    Application.ScreenUpdating = False

    Application.Calculation = xlCalculationManual

    Application.EnableEvents = False

    ActiveSheet.DisplayPageBreaks = False

    ' ---&--- Cuenta el numero de filas con datos

    ReDim Preserve Filas(1)

    ReDim Preserve Ultimo(1)

    Sheets("Hoja1").Select

    Num_Hojas = 1

    Filas(1) = 2

    While Cells(Filas(1), "A") <> Empty

       Filas(1) = Filas(1) + 1

    Wend

    Filas(1) = Filas(1) - 1

    ' ---&--- Ordena por la columna A

    Columns("A:E").Select

    ActiveWorkbook.Worksheets("Hoja1").Sort.SortFields.Clear

    ActiveWorkbook.Worksheets("Hoja1").Sort.SortFields.Add2 _

                  Key:=Range("A2:A" & Filas(1)), _

                  SortOn:=xlSortOnValues, _

                  Order:=xlAscending, _

                  DataOption:=xlSortNormal

    With ActiveWorkbook.Worksheets("Hoja1").Sort

        .SetRange Range("A1:E" & Filas(1))

        .Header = xlYes

        .MatchCase = False

        .Orientation = xlTopToBottom

        .SortMethod = xlPinYin

        .Apply

    End With

    Range("A2").Select

    ' ---&--- Busca duplicados

    Filas(1) = 2

    While Cells(Filas(1), "A") <> ""

        ID = Cells(Filas(1), "A")

        If ID = Cells(Filas(1) - 1, "A") Then

            Hoja = Num_Hojas + 1

            For a = 2 To Num_Hojas

                If Ultimo(a) <> ID Then

                    Hoja = a

                    Exit For

                End If

            Next

            If Hoja > Num_Hojas Then

                ReDim Preserve Filas(Hoja)

                ReDim Preserve Ultimo(Hoja)

                Filas(Hoja) = 2

                Num_Hojas = Num_Hojas + 1

                ActiveWorkbook.Sheets.Add After:=Sheets(Sheets.Count)

                Sheets(Sheets.Count).Name = "Hoja_" & Hoja

                Num_Hojas = Hoja

                Range("A1") = "ID"

                Range("B1") = "CODIGO"

                Range("C1") = "FECHA INICIO"

                Range("D1") = "FECHA FIN"

                Sheets("Hoja1").Select

            End If

            Ultimo(Hoja) = ID

            With Sheets("Hoja_" & Hoja)

                .Cells(Filas(Hoja), "A") = ID

                .Cells(Filas(Hoja), "B") = Cells(Filas(1), "B")

                .Cells(Filas(Hoja), "C") = Cells(Filas(1), "C")

                .Cells(Filas(Hoja), "D") = Cells(Filas(1), "D")

                .Range("C" & Filas(Hoja)).NumberFormat = "dd/mm/yyyy"

                .Range("D" & Filas(Hoja)).NumberFormat = "dd/mm/yyyy"

                Filas(Hoja) = Filas(Hoja) + 1

            End With

            Rows(Filas(1) & ":" & Filas(1)).Select

            Selection.Delete Shift:=xlUp

        Else

            Filas(1) = Filas(1) + 1

        End If

    Wend

End Sub

¿Que hace?

-- Ordena por la columna A (Campo ID)
-- Empieza en la fila 2 hasta que encuentre una celda vacía.
-- Si el ID es diferente al anterior, no está repetido salta a la fila siguiente.
-- Si esta repetido mira en las hojas siguientes si es igual al último que se guardo en cada hoja y en la primera que no este lo escribe.
-- Si esta repetido en todas las hojas crea una nueva, pone la cabecera y escribe los datos.
-- Tiene un contador de filas de todas las hojas.
-- Borra la fila en la primera hoja y NO salta de línea.

De una sola pasada reparte todos los duplicados en diferentes hojas.

Saludos.
\\//_

Valora esta respuesta

Comentar

Busqueda y filtrado de duplicados con VBA

Publicado por Miguel (14 intervenciones) el 01/12/2021 17:35:23

Estimado, funciona de maravilla!!, es pegar, activar la macro y ualaá!
Le agradezco enormemente el aporte!!

Valora esta respuesta

Comentar

Busqueda y filtrado de duplicados con VBA

Publicado por Miguel (14 intervenciones) el 06/04/2022 20:37:10

Estimado,

La macro anterior funciona de maravilla, pero ahora tengo un error, creo que es por la cantidad de caracteres que tengo en cada celda. En los ejemplos anteriores yo colocaba un ID de una persona (8 caracteres max), ahora yo tengo hasta 18 caracteres por celda. Cuando ejecuto la Macro, me salta el error "Se ha producido el error en ejecución 6: Desbordamiento". Según investigué es porque la variable es igualada a Integer y lo mejor sería cambiarla a Long (Pero en ese código no veo una variable as Integer, asique no entiendo como corregirlo.

En la imagen, puede ver que cantidad de caracteres habría en la columna A.

El error me lo señala en la línea 51: ID = Cells(Filas(1), "A")

Agradezco su tiempo...
Miguel.-

Sin-titulo

Valora esta respuesta

Comentar

Pos: 2

Val: 4.908

Busqueda y filtrado de duplicados con VBA

Publicado por Antoni Masana (2540 intervenciones) el 07/04/2022 15:01:14

Pon al inicio de la macro:

Sub ...()

    Dim ID as Long

...

    ID = Cells(Filas(1), "A")

Tipos de Variables númericas:

Byte
Se utiliza para guardar números positivos enteros desde 0 a 255. Ocupa 1 byte en la memoria.

Integer
Este tipo de variable también ocupa 2 bytes pero puede almacenar un rango de números enteros muy alto: desde -32.768 hasta 32.767.

Long
También almacena números enteros desde -2.147.483.648 hasta 2.147.483.647.

Currency
Se utiliza para cálculos donde intervienen monedas. Puede almacenar un rango desde -922.334.203.685.477,5808 hasta 922.337.203.685.477,5807. Ocupa 8 bytes en memoria.

Single
Se suele utiliza para almacenar números fraccionarios periódicos. Abarca desde -3,4028235E+38 a -1,401298E-45 para números negativos y 1,401298E-45 a 3,4028235E+38 para números positivos. Ocupa 4 bytes en memoria.

Double
Similar al anterior pero con mucha más capacidad. Ocupa 8 bytes en memoria y comprende desde -1,79769313486231570E+308 a -4,94065645841246544E-324 para los valores negativos y desde 4,94065645841246544E-324 a 1,79769313486231570E+308 para los valores positivos.

Saludos.
\\//_

Valora esta respuesta

Comentar

Busqueda y filtrado de duplicados con VBA

Publicado por Miguel (14 intervenciones) el 08/04/2022 17:16:34

Estimado, esa variable ya esta declarada en el comienzo de la macro. Si la coloco nuevamente, me sale el error de duplicación.

Valora esta respuesta

Comentar

Pos: 2

Val: 4.908

Busqueda y filtrado de duplicados con VBA

Publicado por Antoni Masana (2540 intervenciones) el 08/04/2022 20:03:12

Sube el libro y le doy un vistazo.

Saludos.
\\//_

Valora esta respuesta

Comentar

cambiar color de celda según el valor de otra

Duplicados