Números repetidos

Raul,

Seguramente hay una solucion mas elegante y mas facil, pero por si te urge,
he escrito el codigo de abajo. Que conste q lo hice en la oficina a marchas
forzadas para poder salir cuanto antes, por lo cual no prestE mucha atencion
a la forma sino al resultado. El codigo es largo - asegurate de copiarlo
todo, crear un nuevo modulo (digamos Modulo1) desde el editor VBA y pegarlo
todo ahi. Puedes asignar el macro a un boton o llamarlo desde el menu
Herramientas>Macro>Macros o tecleando Alt+F8. Tambien dentro del codigo
tendras q modificar el nombre de la hoja en la q apareceria el extracto, el
rango que contiene los valores a evaluar y posiblemente anadir mas hojas a
excluir de la evaluacion. Acuerdate de hacer backup de tu fichero antes de
usar el macro. Si hay algun problema comentalo aqui. Me imagino q ya vendran
soluciones mejores.

Un saludo,
KL

'Inicio Codigo
Sub SacarValoresRepetidos()
Dim MisHojas As Variant
Dim MisValores As Variant
Dim Contador As Single

'Congelamos la pantalla.
Application.ScreenUpdating = False
With ThisWorkbook

'Borramos la lista anterior.
.Sheets("Sheet1").Range("A1").CurrentRegion.ClearContents

'Creamos la lista de hojas a evaluar incluyendo
'todas las hojas menos la Sheet1.
ReDim MisHojas(0)
For Each hoja In .Worksheets
If hoja.Name <> "Sheet1" Then
MisHojas(UBound(MisHojas)) = hoja.Name
ReDim Preserve MisHojas(UBound(MisHojas) + 1)
End If
Next hoja
ReDim Preserve MisHojas(UBound(MisHojas) - 1)

'Seleccionamos las hojas y el rango a evaluar
'para poder usarlos como un rango unico.
Worksheets(MisHojas).Select
Range("A1:C30").Select

'Usando la funcion de John Walkenbach
'sacamos la lista de valores unicos.
MisValores = UniqueItems(Selection, False)

'Pasamos la lista de valores unicos a
'la hoja Sheet1 omitiendo los q no se
'repiten o son iguales a "".
For i = LBound(MisValores) To UBound(MisValores)
If WorksheetFunction.CountIf(Selection, MisValores(i)) > 1 _
And MisValores(i) <> "" Then
With .Worksheets("Sheet1")
.Cells(Contador + 1, 1) = MisValores(i)
.Cells(Contador + 1, 2) = WorksheetFunction. _
CountIf(Selection, MisValores(i))
Contador = Contador + 1
End With
End If
Next i

'Quitamos la seleccion del rango evaluado,
'deselcionamos las hojas y aprovechamos para
'volver a la hoja Sheet1.
Range("A1").Select
.Sheets("Sheet1").Select

'Ordenamos el extracto en orden descendiente
Range("A1").CurrentRegion.Sort Key1:=Range("A1"), _
Order1:=xlAscending
End With
End Sub

Function UniqueItems(ArrayIn, Optional Count As Variant) As Variant
Dim Unique() As Variant ' array that holds the unique items
Dim Element As Variant
Dim i As Integer
Dim FoundMatch As Boolean

If IsMissing(Count) Then Count = True

NumUnique = 0

For Each Element In ArrayIn
FoundMatch = False

For i = 1 To NumUnique
If Element = Unique(i) Then
FoundMatch = True
GoTo AddItem '(Exit For-Next loop)
End If
Next i

AddItem:
If Not FoundMatch Then
NumUnique = NumUnique + 1
ReDim Preserve Unique(NumUnique)
Unique(NumUnique) = Element
End If

Next Element
If Count Then UniqueItems = NumUnique Else UniqueItems = Unique
End Function
'Fin Codigo




"Raul Z." wrote in message
news:

Hola a todos
Tengo un libro con 20 hojas y en cada hoja tengo 4 columnas con numeros x
ej.

A B C D
1 28 32 11 9
2 36 75 8 54
3 33 43 6 32
4 29 98 5 28
5 43 77 63 88
6 11 84 13 15

Como puedo hacer para informar en una hoja distinta los numero repetidos,
o
sea que siguiendo el ej. anterior me diga:

A
1 28
2 32
3 11

etc.etc.
Muchas gracias
Raul