Buscar Valor

Hola Pedro,

Mira a ver si te sirve el siguiente codigo. Este codigo asume que los
valores se encuentran en la hoja "Hoja1" y los resultados se deben devolver
en la hoja "Resumen". Ademas asume que no habria mas de 9999 valores unicos
en tu lista. Cambia los nombres de hojas en el codigo por los reales.

Saludos,
KL

'Inicio Codigo-
Sub BuscarDuplicadas()
Dim C As Range
Dim Resultados As Range
Dim res As Variant 'resultado de Match()
Dim j As Long
Dim i As Long
Dim k As Long
Dim LLaves As Variant
Dim Veces As Variant
Dim Direcciones As Variant
Dim miRng As Range 'variable para el rango a evaluar.

Set Resultados = Worksheets("Resumen").Range("A2:C10000")

'Establece el rango a evaluar para la hoja.
With Worksheets("Hoja1")
Set miRng = .Range(.Cells(2, 1), _
.Cells(.Range("A65536").End(xlUp).Row, 1))
End With

For Each C In miRng
'saltar celdas con error
If Not IsError(C.Value) Then
'saltar celdas vacias
If C.Value <> "" Then
If j = 0 Then
res = CVErr(xlErrNA)
ReDim LLaves(1 To 1)
ReDim Veces(1 To 1)
ReDim Direcciones(1 To 1)
Else
res = Application.Match(C.Value, LLaves, 0)
End If
If IsError(res) Then
j = j + 1
ReDim Preserve LLaves(1 To j)
ReDim Preserve Veces(1 To j)
ReDim Preserve Direcciones(1 To j)
LLaves(j) = C.Value
Veces(j) = 1
Direcciones(j) = LaDireccion(C)
Else
Veces(res) = Veces(res) + 1
Direcciones(res) = Direcciones(res) & " " _
& LaDireccion(C)
End If
End If
End If
Next C

'Borrar resultados anteriores
Resultados.ClearContents

'Mostrar resultados
k = 1
For i = 1 To j
If Veces(i) > 1 Then
Resultados(k, 1) = LLaves(i)
Resultados(k, 2) = Veces(i)
Resultados(k, 3) = Direcciones(i)
k = k + 1
End If
Next i

Resultados.Resize(k, 3).Sort key1:=Resultados.Cells(1, 2), _
order1:=xlDescending, header:=xlNo
End Sub

Private Function LaDireccion(C As Range) As String
Dim s As String
Dim i As Integer
s = C.Address(False, False, xlA1, True)
i = InStr(1, s, "]")
LaDireccion = Mid(s, i + 1)
End Function
'Fin Codigo