1

Estoy tratando de entender como hacer una macro en Excel que me elimine duplicados con condiciones especificas, a continuación muestro el ejemplo de lo que quiero hacer,

la tabla ejemplo que muestro a continuación es la tabla sin ningún proceso a resultado introducir la descripción de la imagen aquí

y la tabla ejemplo que muestro a continuación es la tabla con los resultados esperados a obtener introducir la descripción de la imagen aquí

las condiciones que quiero se procesen es esta tabla en una macro que elimine duplicados son estas

introducir la descripción de la imagen aquí introducir la descripción de la imagen aquí

Hasta ahora tengo una muy buena macro que elimina duplicados, pero aun no he logrado modificarla para añadir estas condiciones en las líneas de código.

Les comparto la macro, es la siguiente:

Sub RepetidosVH()
    'Declaración del diccionario
    Dim dic As Scripting.Dictionary
    Set dic = New Scripting.Dictionary
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Range("C3").Select
    Do While Not IsEmpty(ActiveCell)
        If dic.Exists(ActiveCell.Text) Then
            ActiveCell.EntireRow.Delete
        Else
            'En esta instrucción lo que interesa es almacenar el valor de la celda como key,
            'el dato equivalente al value no tiene importancia
            dic.Add ActiveCell.Text, "1"
            ActiveCell.Offset(1, 0).Select
        End If
    Loop
    'limpia los recursos utilizados
    dic.RemoveAll
    Set dic = Nothing
    Range("C3").Select
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Les comparto el archivo de Excel donde esta el ejemplo que muestro anteriormente. https://drive.google.com/file/d/1KJkYZmBJP8zxgVrcS0NfxxnmZxV1xTr3/view?usp=sharing

1 respuesta 1

3

Prueba esto,

'C)COLOR D)INTERNO_DE E)CLASE_DEMA F)COUNT_AREA G)SUM_AREA H)SUM_LENGTH

Sub EliminarRepetido_Con_Condiciones()
Dim uF&, n&, m&, nVeces%, INTERNO_DE, CLASE_DEMA, COLOR
    uF = Range("C" & Rows.Count).End(xlUp).Row
    For n = 3 To uF
        nVeces = Application.WorksheetFunction.CountIf(Range("D3:D" & uF), Cells(n, "D"))
        If nVeces = 2 Then
            If Cells(n, "E") = "PCP" Or Cells(n, "E") = "PE" Or Cells(n, "E") = "PCC" Then
                Cells(n + 1, "E").EntireRow.Delete
            ElseIf Cells(n, "E") = "PSP47A" Then
                If Cells(n, "G") > Cells(n + 1, "G") Then
                    Cells(n + 1, "G").EntireRow.Delete
                End If
            ElseIf Cells(n, "E") = "RPA" Then
                If Cells(n, "F") = Cells(n + 1, "F") And Cells(n, "F") >= 9 Then
                    Cells(n + 1, "E").EntireRow.Delete
                Else
                    Cells(n, "F") = Cells(n, "F") + Cells(n + 1, "F")
                    Cells(n + 1, "E").EntireRow.Delete
                End If
            ElseIf Cells(n, "E") = "RV" Or Cells(n, "E") = "RE" Then
                    Cells(n, "G") = Cells(n, "G") + Cells(n + 1, "G")
                    Cells(n + 1, "G").EntireRow.Delete
            End If
        ElseIf nVeces = 3 Then
            If Cells(n, "E") = "PCP" Or Cells(n, "E") = "PE" Then
                Cells(n + 2, "E").EntireRow.Delete
                n = n + 1
            End If
        End If
    Next n
End Sub
1
  • 1
    Gracias! funciono perfecto Commented el 31 may. 2021 a las 2:00

Tu Respuesta

By clicking “Publica tu respuesta”, you agree to our terms of service and acknowledge you have read our privacy policy.

¿No es la respuesta que buscas? Examina otras preguntas con la etiqueta o formula tu propia pregunta.