Mejorar código de búsqueda de repetidos
Tengo el siguiente código que me busca los repetidos de acuerdo a un rango en una hoja excel pero tiene un error ya que los números repetidos que comienzan por cero no me los da como podríamos modificarla
Muchas gracias
Sub Repetidos() 'Por.Dante Amor col = "TG" ' Application.StatusBar = False Application.ScreenUpdating = False c = Columns(col).Column Range(Cells(1, c), Cells(1, c + 2)).EntireColumn.ClearContents cuenta = Range("A1:SZ217").SpecialCells(xlCellTypeConstants, 23).Count m = 1 For Each n In Range("A1:SZ217").SpecialCells(xlCellTypeConstants, 23) Application.StatusBar = "Paso 1, procesando celda: " & m & " de: " & cuenta Set b = Columns(c).Find(n.Value, lookat:=xlWhole) If Not b Is Nothing Then Cells(b.Row, c + 1) = Cells(b.Row, c + 1) + 1 Cells(b.Row, c + 2) = Cells(b.Row, c + 2) & ", " & n.Address(False, False) Else u = Range(col & Rows.Count).End(xlUp).Row + 1 Cells(u, c) = n.Value Cells(u, c + 1) = 1 Cells(u, c + 2) = n.Address(False, False) End If m = m + 1 Next m = 1 For i = u To 1 Step -1 Application.StatusBar = "Paso 2, procesando celda: " & m & " de: " & u If Cells(i, c + 1) = 1 Then Range(Cells(i, c), Cells(i, c + 2)).Delete Shift:=xlUp End If m = m + 1 Next ' With ActiveSheet.Sort .SortFields.Clear .SortFields.Add Key:=Range(Cells(1, c + 1), Cells(u, c + 1)), _ SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal .SetRange Range(Cells(1, c), Cells(u, c + 2)) .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Application.StatusBar = False Application.ScreenUpdating = True MsgBox "Fin" End Sub