|
Q+ Ricardots,
Prueba con este codigo:
Sub EliminarRepetidosYRegistro()
Dim Contador, Valor, Repetidos, Cuantos
Range("A2").Select
Range("A2:A29").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Contador = 1
Valor = ActiveCell.Value
ActiveCell.Offset(1, 0).Range("A1").Select
While ActiveCell.Value <> ""
If ActiveCell.Value = Valor Then
ActiveSheet.Next.Select
If ActiveCell.Value <> Valor Then
ActiveCell.Offset(1, 0).Range("a1").Select
ActiveCell.Value = Valor
End If
ActiveSheet.Previous.Select
Selection.Delete Shift:=xlUp
Contador = Contador + 1
Else
If Contador <> 1 Then
ActiveSheet.Next.Select
ActiveCell.Offset(0, 1).Range("a1").Select
ActiveCell.Value = Contador
ActiveCell.Offset(0, -1).Range("a1").Select
ActiveSheet.Previous.Select
End If
Contador = 1
Valor = ActiveCell.Value
ActiveCell.Offset(1, 0).Range("A1").Select
End If
Wend
If Contador <> 1 Then
ActiveSheet.Next.Select
ActiveCell.Offset(0, 1).Range("a1").Select
ActiveCell.Value = Contador
ActiveCell.Offset(0, -1).Range("a1").Select
ActiveSheet.Previous.Select
End If
Cuantos = Range("Cuantos")
Respuesta = MsgBox("Se han encontrado " & Cuantos & " elementos repetidos", 1, "Número de repetidos")
End Sub
Saludos,
RCh.
|