Como eliminar duplicados si se cumple una condición

Necesito crear una macro donde se pueda eliminar los duplicados si se cumple una condición, me explico tengo 5 columnas Nombre, Vehículo, Evento, Fecha, Hora,

En evento tengo dos opciones normal y exceso de velocidad, lo que quiero es quitar todos los duplicados de un conductor en una misma fecha que anduvo con una velocidad normal.

¿Me explique bien?

2

2 respuestas

Respuesta
1

Te anexo la macro, cambia en la macro "Hoja1" por el nombre de tu hoja.

Sub EliminarDuplicados()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set h1 = Sheets("Hoja1")
    h1.[A1].AutoFilter
    u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
    h1.Range("A1:E" & u1).AutoFilter Field:=3, Criteria1:="Normal"
    h1.Range("A1:E" & u1).Copy
    '
    Set h2 = Sheets.Add(After:=Sheets(Sheets.Count))
    h2.Paste
    u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
    h2.Range("A1:E" & u2).RemoveDuplicates Columns:=Array(1, 4), Header:=xlYes
    h1.Range("A2", "A" & u1).EntireRow.Delete
    h1.[A1].AutoFilter
    '
    u1 = h1.Range("A" & Rows.Count).End(xlUp).Row + 1
    u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
    If u2 = 1 Then u2 = 2
    h2.Range("A2:E" & u2).Copy h1.Range("A" & u1)
    h2.Delete
    h1.Select
    Application.ScreenUpdating = True
    MsgBox "Terminado"
End Sub

Lo que hace la macro es extraer todos los registros que tengan el evento "Normal", los pasa a una hoja temporal y elimina todos los duplicados, después regresa a la hoja1 solamente los registros únicos; es probable que los registros queden ordenados de otra forma, solamente tienes que ordenarlos nuevamente por nombre o por fecha o por la columna que normalmente utilizas para ordenar.


Saludos. Dante Amor

Gracias por la respuesta Dante pero no es a lo que me refiero, lo que necesito es evaluar a los conductores con una nota según la cantidad de eventos que tuvieron, por lo tanto si un conductor no tuvo ningún evento de exceso tengo que dejar al menos un evento normal para ponerle la nota máxima (7.0), entonces los paso que debo hacer son algo asi como filtrar primero todos los eventos normales y sobre eso quitar duplicados por evento por conductor fecha y patente. se entiende bien? 

Adjunto un excel con datos para que se entienda un poco mas!

Muchas gracias Dante!ejemplo

no pude subir el excel parece que no se puede!

Se entiende, pero en tu pregunta original habías puesto estos datos:

          A             B             C            D         E

1 Nombre Vehículo Evento Fecha Hora

2

Ahora los pones así:

        A               B             C           D           E            F

1 Conductor Fecha Evento Hora Speed patente

2

En la pregunta original no mencionaste la patente, entonces la macro no puede funcionar si omites datos.

Puedes confirmarme cómo tienes los datos, y poner un ejemplo con datos reales; en una imagen pon cómo tienes los datos y en la segunda imagen pon el resultado que esperas. En la imagen 1 me marcas cuáles son los datos que se van a eliminar.

Bueno en verdad son más columnas aquí van las dos fotos Antes y Después

El conductor 1 no tuvo excesos de velocidad y los conductores 2 y 3 si necesito que quede así:

El conductor 1 como no tuvo excesos de velocidad dejamos un evento normal para después agregarle la columna y ponerle que tuvo la nota máxima, en cambio los conductores que si tuvieron excesos borro todos los eventos normales y después les pongo la nota que se va descontando por cada exceso cometido (eso de la nota es otra macro que ya la tengo). Pero necesito quitar duplicados porque el sistema me arroja demasiados datos y la macro se demora mucho.

Muchísimas Gracias por tu ayuda!

¿Ya no se considera la patente?

Necesito que:

-Si el conductor tuvo eventos de excesos que elimine todos los evento normales

-Si el conductor NO tuvo eventos de excesos elimine todos los eventos normales menos 1

Seria algo así como quitar los duplicados de conductor y fecha y patente solo de los eventos normales.

No me respondiste esto:

¿Ya no se considera la patente?

En un mensaje anterior pusiste que se considere la patente y en el siguiente ya no consideraste la patente.

¿Me puedes confirmar si no se requiere la patente?

Si se requiere ya que un conductor puede manejar varios vehículos en un día

Entonces pon un ejemplo completo considerando la patente, de igual forma el antes y el después. En el ejemplo, pusiste solamente 1 patente, pon un ejemplo donde aparezcan más de una patente para visualizar el resultado que esperas.

Te anexo la nueva macro. Pon tus datos en la hoja "Hoja1", el resultado quedará en la "Hoja2"

Cambia en la macro "Hoja1" y "Hoja2" por los nombres que quieras.

Sub EliminarDuplicados()
'Por.Dante Amor
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("Hoja2")
    '
    h2.Cells.Clear
    h1.Rows(1).Copy h2.Rows(1)
    '
    j = 2
    For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
        If UCase(h1.Cells(i, "D")) <> "NORMAL" Then
            h1.Rows(i).Copy h2.Rows(j)
            j = j + 1
        End If
    Next
    '
    For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
        If UCase(h1.Cells(i, "D")) = "NORMAL" Then
            Set r = h2.Columns("A")
            Set b = r.Find(h1.Cells(i, "A"), lookat:=xlWhole)
            If Not b Is Nothing Then
                celda = b.Address
                existe = False
                Do
                    If h2.Cells(b.Row, "C") = h1.Cells(i, "C") And _
                       h2.Cells(b.Row, "I") = h1.Cells(i, "I") Then
                        existe = True
                    End If
                    Set b = r.FindNext(b)
                Loop While Not b Is Nothing And b.Address <> celda
                If existe = False Then
                    h1.Rows(i).Copy h2.Rows(j)
                    j = j + 1
                End If
            Else
                h1.Rows(i).Copy h2.Rows(j)
                j = j + 1
            End If
        End If
    Next
End Sub

Saludos.Dante Amor

Recuerda valorar la respuesta.

Gracias Dante esta muy cerca de lo que necesito, la macro de momento me esta eliminando también los excesos de velocidad, necesito que solo elimine los eventos normales.

Como se muestra en las imágenes que subí los conductores 2 y 3 quedan con sus excesos de velocidad originales y el conductor 1 que no tenia excesos de velocidad queda con solo 1 evento normal (para saber que si anduvo en vehículo y al no tener excesos de velocidad tiene la nota máxima)

Muchísimas gracias dante por tu tiempo y paciencia en serio!

Revisa bien tus datos.

Lo primero que hace la macro es copiar los excesos a la hoja2

Tienes que tener 2 hojas.

Te anexo mi archivo para que veas el funcionamiento de las hojas.

En la Hoja1 te puse un botón, revisa los datos y presiona el botón, en la hoja2 verás el resultado.

https://www.dropbox.com/s/2r0px7e9pe328j3/quitar%20duplicados2.xlsm?dl=0 

Saludos. Dante Amor

si así lo tenia, esta es parte de mi planilla, 

https://drive.google.com/file/d/0B7ufkwcNehajSjVtVjZhSlIxOFE/view?usp=sharing 

Saludos dante!

Te dije revisaras tus datos.

También te pedí que pusieras ejemplos con datos reales, en tu pregunta pusiste que tenías esto: "normal y exceso de velocidad"

Y en tu archivo tienes esto: "Geofence Entered"

La palabra "normal" no es igual a "Geofence Entered", por eso tienes que modificar la macro, si no sabes cómo modificar la macro, me lo puedes pedir con toda confianza, pero no digas que la macro está cerca de lo que necesitas, la macro funciona correctamente, pero tus datos no están bien o no los pusiste adecuadamente desde el principio.

Te anexo la macro con los ajustes para que funcione con la frase: "Geofence Entered".

Sub EliminarDuplicados()
'Por.Dante Amor
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("Hoja2")
    '
    h2.Cells.Clear
    h1.Rows(1).Copy h2.Rows(1)
    '
    j = 2
    For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
        If h1.Cells(i, "D") <> "Geofence Entered" Then
            h1.Rows(i).Copy h2.Rows(j)
            j = j + 1
        End If
    Next
    '
    For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
        If h1.Cells(i, "D") = "Geofence Entered" Then
            Set r = h2.Columns("A")
            Set b = r.Find(h1.Cells(i, "A"), lookat:=xlWhole)
            If Not b Is Nothing Then
                celda = b.Address
                existe = False
                Do
                    If h2.Cells(b.Row, "C") = h1.Cells(i, "C") And _
                       h2.Cells(b.Row, "I") = h1.Cells(i, "I") Then
                        existe = True
                    End If
                    Set b = r.FindNext(b)
                Loop While Not b Is Nothing And b.Address <> celda
                If existe = False Then
                    h1.Rows(i).Copy h2.Rows(j)
                    j = j + 1
                End If
            Else
                h1.Rows(i).Copy h2.Rows(j)
                j = j + 1
            End If
        End If
    Next
    h2.Select
    MsgBox "Terminado"
End Sub

Te regreso tu archivo con la macro funcionando. en la hoja2 podrás ver el resultado.

https://www.dropbox.com/s/0de9f8rg5dmfxdj/Ejemplo%20dam.xlsm?dl=0 

Saludos. Dante Amor

Recuerda valorar la respuesta.

Respuesta

Alguien me puede ayudar con una macro para que me elimine los duplicados con la siguiente condición, ejemplo tengo varios campos matricula, nombre, escuela, localidad nomina, los campos que se repiten son de matricula esto es porque el profesor tiene dos plazas diferentes una de administrativos y una de docentes que es del campo nomina entonces lo que se requiere es que se eliminen los duplicados mientras que la condición es que los administrativos se queden y se eliminen los de docentes de cada duplicado.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas