Otra funcionalidad nativa de Excel que conviene considerar en nuestras macros es Quitar Duplicados
Supongamos que para nuestro proyecto de Vba (macro) necesitamos un código que elimine los duplicados de una lista como ésta (la lista completa incluye 10774 registros con sólo 9 registros únicos)
Como no es obligatorio inventar la rueda cada vez que escribimos código, hacemos una búsqueda en Google (recomendablemente en inglés, para obtener más resultados).
Probablemente encontraremos códigos ineficientes como éste de VBA Express
Sub DeleteDups()
'VBA Express - Jacob Hilderbrand
Dim x As Long
Dim LastRow As Long
LastRow = Range("A65536").End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("A1:A" & x), Range("A" & x).Text) > 1 Then
Range("A" & x).EntireRow.Delete
End If
Next x
End Sub
que podemos mejorar en algo de esta manera
Sub DeleteDups_modified()
'VBA Express - Jacob Hilderbrand
'modificada por Jorge Dunkelman
Dim x As Long
Dim LastRow As Long
LastRow = Application.Intersect(ActiveSheet.UsedRange, _
ActiveSheet.Columns(ActiveCell.Column)).Rows.Count
Debug.Print LastRow
Application.ScreenUpdating = False
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("A1:A" & x), Range("A" & x).Text) > 1 Then
Range("A" & x).EntireRow.Delete
End If
Next x
Application.ScreenUpdating = True
End Sub
Public Sub DeleteDuplicateRows()
o códigos profesionalmente desarrollados como éste de Chip Pearson
Public Sub DeleteDuplicateRows()
'origen:http://www.cpearson.com/excel/deleting.htm
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DeleteDuplicateRows
' This will delete duplicate records, based on the Active Column. That is,
' if the same value is found more than once in the Active Column, all but
' the first (lowest row number) will be deleted.
'
' To run the macro, select the entire column you wish to scan for
' duplicates, and run this procedure.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim R As Long
Dim N As Long
Dim V As Variant
Dim Rng As Range
On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set Rng = Application.Intersect(ActiveSheet.UsedRange, _
ActiveSheet.Columns(ActiveCell.Column))
Application.StatusBar = "Processing Row: " & Format(Rng.Row, "#,##0")
N = 0
For R = Rng.Rows.Count To 2 Step -1
If R Mod 500 = 0 Then
Application.StatusBar = "Processing Row: " & Format(R, "#,##0")
End If
V = Rng.Cells(R, 1).Value
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Note that COUNTIF works oddly with a Variant that is equal to vbNullString.
' Rather than pass in the variant, you need to pass in vbNullString explicitly.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If V = vbNullString Then
If Application.WorksheetFunction.CountIf(Rng.Columns(1), vbNullString) > 1 Then
Rng.Rows(R).EntireRow.Delete
N = N + 1
End If
Else
If Application.WorksheetFunction.CountIf(Rng.Columns(1), V) > 1 Then
Rng.Rows(R).EntireRow.Delete
N = N + 1
End If
End If
Next R
EndMacro:
Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Duplicate Rows Deleted: " & CStr(N)
End Sub
Siguiendo la técnica que mostré en la nota anterior podemos generar código que use la funcionalidad Quitar Duplicados. Activamos la grabadora de macros para grabar las acciones de eliminar los duplicados. El código generado es el siguiente
Sub Macro1()
'
ActiveSheet.Range("$A$1:$A$10775").RemoveDuplicates _
Columns:=1, Header:=xlYes
End Sub
Mejoramos este código de la siguiente manera
Sub remove_dups_1()
Selection.RemoveDuplicates Columns:=1, Header:=xlGuess
End Sub
Como podemos ver, un código muy compacto y claro. La pregunta ahora es: ¿cuál es el código que corre más rápido?. En mi máquina los resultados fueron los siguientes:
- DeleteDups: 78 segundos
- DeleteDups_modified: 7.5 (mejora como consecuencia de usar Application.ScreenUpdating = True)
- DeleteDuplicateRows: 7.0 segundos
- remove_dups_1: 0.047 segundos
Resumiendo: DeleteDups_modified y DeleteDups son aproximadamente 11 veces más rápidas que la infeciente DeleteDups; pero remove_dups_1, basada en la funcionalidad Remover Duplicados, es casi 150 veces más rápida que DeleteDups_modified y DeleteDups y 1660 veces más rápida que la ineficiente DeleteDups.
Como en la nota anterior concluimos: siempre conviene considerar el uso de funcionalidades nativas de Excel en nuestros códigos.
Como en la nota anterior concluimos: siempre conviene considerar el uso de funcionalidades nativas de Excel en nuestros códigos.
