En este artículo, crearemos una macro para eliminar registros duplicados de los datos.

Los datos brutos consisten en datos de empleados, que incluyen nombre, edad y sexo.

ArrowMain

Explicación lógica

Hemos creado una macro «RemovingDuplicate» para eliminar registros duplicados de los datos. Esta macro primero obtiene los datos en una secuencia y luego hace una comparación entre los valores de dos filas consecutivas para encontrar registros duplicados.

ArrowOutput

Explicación del código

ActiveSheet.Sort.SortFields.Clear El código anterior se utiliza para eliminar cualquier ordenamiento previo de los datos.

ActiveSheet.Sort.SortFields.Add Key: = Range (Selection.Address), _ SortOn: = xlSortOnValues, Order: = xlAscending, DataOption: = xlSortTextAsNumbers El código anterior se utiliza para ordenar los datos en la primera columna en orden ascendente.

Para i = ActiveSheet.Cells (Rows.Count, Selection.Column) .End (xlUp) .Row To Selection.Row + 1 Step -1 El código anterior se usa para aplicar el bucle inverso, comenzando desde la última fila hasta la fila seleccionada.

ActiveSheet.Rows (i) .Delete shift: = xlUp El código anterior se usa para eliminar una fila y mover el cursor a la fila superior.

Siga el código a continuación

Option Explicit

Sub RemovingDuplicate()

'Declaring variables

Dim i  As Long

'Disabling screen updates

Application.ScreenUpdating = False

Range("A11").Select

ActiveSheet.Sort.SortFields.Clear

'Sorting data in ascending order

ActiveSheet.Sort.SortFields.Add Key:=Range(Selection.Address), _

SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers

With ActiveSheet.Sort

.SetRange Range(Selection.Offset(1, 0), ActiveSheet.Cells(Rows.Count, Selection.End(xlToRight).Column).End(xlUp))

.Header = xlNo

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

'Looping through all the cells

For i = ActiveSheet.Cells(Rows.Count, Selection.Column).End(xlUp).Row To Selection.Row + 1 Step -1



'Comparing value of two adjacent cells for duplicate records

If ActiveSheet.Cells(i, Selection.Column).Value = ActiveSheet.Cells((i - 1), Selection.Column).Value Then



'Delete the duplicate record

ActiveSheet.Rows(i).Delete shift:=xlUp

End If



Next i

'Enabling screen updates

Application.ScreenUpdating = True

End Sub

Si te gustó este blog, compártelo con tus amigos en Facebook y Facebook.

Nos encantaría saber de usted, háganos saber cómo podemos mejorar nuestro trabajo y hacerlo mejor para usted. Escríbanos a [email protected]