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

Hola KL
Muchas gracias x atender mi respuesta.
Te cuento los pasos q realicé:
El libro tiene las hojas llamadas x ej. "pepe" "pipo" "popo" etc. y cree
otra llamada "repetidos", cambié todo lo que en el codigo decia "sheet1" x
"repetido" bien.
amplie el rango en
Range("A1:C30").Select
y puse el que realmente va que es = en todas las hojas.

Como resultado y a pesar de tener número repetido en varias hojas la macro
termina en "repetido", pero vacía.

Me falta algo?

Gracias.


"KL" escribió:

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

Hola nuevamente KL
Haciendo nuevas pruebas, descubro que si repito números en la primera hoja
del libro si me los expone en "repetidos", no se como hacer para las demás.
Gracias

"KL" escribió:

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

Raul,

Tienes razon - no funciona. Voy a ver si se me ocurre otra cosa.

KL

"Raul Z." wrote in message
news:

Hola nuevamente KL
Haciendo nuevas pruebas, descubro que si repito numeros en la primera hoja
del libro si me los expone en "repetidos", no se como hacer para las
demas.
Gracias

"KL" escribio:

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

Raul,

prueba este codigo.

Saludos,
KL

'Inicio Codigo
Sub SacarValoresRepetidos()
Dim Valores As Variant
Dim ValoresUnicos As Variant
Dim Hoja As Worksheet
Dim HojaInicial As Worksheet
Dim HojaExtracto As Worksheet
Dim RangoExtracto As Range
Dim RangoBaseDeDatos As String
Dim Celda As Range
Dim Cnt As Single
Dim Ocurrencias As Single

Set HojaExtracto = ThisWorkbook.Worksheets("Hoja1")
Set RangoExtracto = HojaExtracto.Range("A1")
Set HojaInicial = ActiveSheet
RangoBaseDeDatos = "A1:D3000"

RangoExtracto.CurrentRegion.ClearContents

Application.ScreenUpdating = False
ReDim Valores(0)
For Each Hoja In ThisWorkbook.Sheets
If Hoja.Name <> HojaExtracto.Name Then
For Each Celda In Hoja.Range(RangoBaseDeDatos)
Valores(UBound(Valores)) = Celda.Value
ReDim Preserve Valores(UBound(Valores) + 1)
Next Celda
End If
Next Hoja

ValoresUnicos = UniqueItems(Valores, False)
For i = LBound(ValoresUnicos) To UBound(ValoresUnicos)
If ValoresUnicos(i) <> "" Then
For Each Hoja In ThisWorkbook.Sheets
If Hoja.Name <> HojaExtracto.Name Then
Ocurrencias = Ocurrencias + _
WorksheetFunction.CountIf(Hoja. _
Range(RangoBaseDeDatos), _
ValoresUnicos(i))
End If
Next Hoja
RangoExtracto.Offset(Cnt, 0) = ValoresUnicos(i)
RangoExtracto.Offset(Cnt, 1) = Ocurrencias
Ocurrencias = 0
Cnt = Cnt + 1
End If
Next i
HojaExtracto.Activate
RangoExtracto.CurrentRegion.Sort Key1:=Range("A1"), _
Order1:=xlAscending
HojaInicial.Activate
End Sub

Function UniqueItems(ArrayIn, Optional Count As Variant) As Variant
' Accepts an array or range as input
' If Count = True or is missing, the function returns the number
' of unique elements
' If Count = False, the function returns a variant array of unique
' elements

Dim Unique() As Variant ' array that holds the unique items
Dim Element As Variant
Dim i As Integer
Dim FoundMatch As Boolean

' If 2nd argument is missing, assign default value
If IsMissing(Count) Then Count = True

' cnt for number of unique elements
NumUnique = 0

' Loop thru the input array
For Each Element In ArrayIn
FoundMatch = False

' Has item been added yet?
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 in list, add the item to unique list
If Not FoundMatch Then
NumUnique = NumUnique + 1
ReDim Preserve Unique(NumUnique)
Unique(NumUnique) = Element
End If

Next Element

' Assign a value to the function
If Count Then UniqueItems = NumUnique Else UniqueItems = Unique
End Function
'Fin Codigo

"KL" wrote in message
news:192yd.4532053$

Raul,

Tienes razon - no funciona. Voy a ver si se me ocurre otra cosa.

KL

"Raul Z." wrote in message
news:

Hola nuevamente KL
Haciendo nuevas pruebas, descubro que si repito numeros en la primera
hoja
del libro si me los expone en "repetidos", no se como hacer para las
demas.
Gracias

"KL" escribio:

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