Home / Questions / 455782
Accepted
Karla Rojas
Asked: 2022-05-29 10:45:29 +0800 CST 2022-05-29 10:45:29 +0800 CST

How to remove duplicates in Excel considering conditions?

  • 772

I am trying to understand how to make a macro in Excel that eliminates duplicates with specific conditions, below I show the example of what I want to do,

the example table that I show below is the table without any process to result enter image description here

and the example table that I show below is the table with the expected results to obtain enter image description here

the conditions that I want to be processed is this table in a macro that eliminates duplicates are these

enter image description here enter image description here

So far I have a very good macro that removes duplicates, but I haven't managed to modify it to add these conditions in the lines of code yet.

I share the macro, it is as follows:

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

I share the Excel file where the example I show above is. https://drive.google.com/file/d/1KJkYZmBJP8zxgVrcS0NfxxnmZxV1xTr3/view?usp=sharing

excel

1 Answers

  1. Best Answer

    Try this,

    'C)COLOR D)INTERNAL_DE E)CLASS_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
    • 3