1

He intentado ajustar una macro que me elimine valores duplicados en cuanto a que funcione en caso que los valores que va a intervenir sean demasiados, estoy utilizando el código que muestro y funciona muy bien cuando la lista de valores es poca, pero al ejecutarla a una lista con mayor número de valores se demora bastante, quisiera si es posible me pudieran ayudar a tener una macro con esta funcionalidad de quitar duplicados de forma más eficiente en el caso que les presento.

Sub RepetidosGEO_SEGMENTO()
Application.ScreenUpdating = False
Range("A5").Select
Do While Not IsEmpty(ActiveCell)
x = WorksheetFunction.CountIf(Range("A:A"), ActiveCell)
If x > 1 Then
ActiveCell.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
Range("A5").Select
Application.ScreenUpdating = True
End Sub
2
  • 1
    Hay un truco para eliminar duplicados de manera rápida: Ordena la columna de datos, luego en la columna del costado pregunta si la celda es igual a la anterior, de ser el caso, antes de eliminar el duplicado, colorea el background, de tal manera puedas comprobar antes de eliminar. Buena suerte :D
    – fredyfx
    Commented el 30 jul. 2020 a las 15:19
  • 1
    Hice 3 pruebas usando Collection, Range.Find y ADODB.Recordset y ninguna ejecuta tan rápido como la solución que tienes actualmente. En una muestra de 28800 valores de los cuales 429 son repetidos, tu solución tarda 41 segundos y la que más se le acercó fue con ADODB.Recordset que tarda 159 segundos, las otras 2 pasan de 400 segundos. Commented el 30 jul. 2020 a las 17:47

2 respuestas 2

2

Después de escribir el comentario donde te mencioné las 3 pruebas hechas hasta ese momento, hice una prueba más con Scripting.Dictionary y en mi escenario de pruebas, esta es la más rápida.

Ten en cuenta que mis pruebas definitivamente son diferentes a tu conjunto de datos, en mi caso el valor comparado tiene un máximo de 10 caracteres.

Para poder hacer uso de Scripting.Dictionary, tienes que agregar la referencia Microsoft Scripting Runtime utilizando el menú Herramientas->Referencias en la ventana del editor de VBA.

Sub RepetidosGEO_SEGMENTO()
    'Declaración del diccionario
    Dim dic As Scripting.Dictionary
    
    Set dic = New Scripting.Dictionary
    
    Application.ScreenUpdating = False
    Range("A5").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("A5").Select
    Application.ScreenUpdating = True
End Sub
2

La solución está en realizar en este codigo, se realiza una grabación de la macro y despues se entra al copdigo a modificar si lo queremos dejar condicionalmente, te dejo el codigo a continuación:

Sub QuitarDuplicados ()
   Columns("A:A").Select
    Selection.FormatConditions.AddUniqueValues
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).DupeUnique = xlDuplicate
    With Selection.FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    ActiveSheet.Range("$A$1:$A$12").RemoveDuplicates Columns:=1, Header:=xlNo
End Sub

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.