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

Añade tu respuesta

Haz clic para o