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