Números repetidos

...mejor aun este:

'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

With ThisWorkbook

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

Application.ScreenUpdating = False
RangoExtracto.CurrentRegion.ClearContents

ReDim Valores(0)
For Each Hoja In .Worksheets
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)
For Each Hoja In .Worksheets
If Not Hoja Is HojaExtracto Then
Ocurrencias = Ocurrencias + _
WorksheetFunction.CountIf(Hoja. _
Range(RangoBaseDeDatos), _
ValoresUnicos(i))
End If
Next Hoja
If ValoresUnicos(i) <> "" And Ocurrencias > 1 Then
RangoExtracto.Offset(Cnt, 0) = ValoresUnicos(i)
RangoExtracto.Offset(Cnt, 1) = Ocurrencias
Cnt = Cnt + 1
End If
Ocurrencias = 0
Next i
HojaExtracto.Activate
On Error GoTo errHandler
RangoExtracto.CurrentRegion.Sort Key1:=Range("A1"), _
Order1:=xlAscending
End With
Exit Sub
errHandler:
MsgBox "No se han detectado valores repetidos."
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" <lapink2000(at)hotmail.com> wrote in message
news:Ok$

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

"Raúl Z." escribió en...

Hola a todos
Tengo un libro con 20 hojas y en cada hoja tengo 4 columnas con números x

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 número repetidos,
o sea que siguiendo el ej. anterior me diga:

A
1 28
2 32
3 11

Hola Raul: Como estoy aprendiendo a usar formulas matriciales, he probado y
he conseguido 'algo' que hace algo parecido a lo que buscas, a ver si te
sirve:

Suposicion:, los número están comprendidos entre 1 y 99
NOTA: Selecciona 100 celdas en columna (p.e. F1:F99) y
escribe lo siguiente en la barra de formulas, finalizando con
MAYUS-CTRL-INTRO:

=K.ESIMO.MAYOR(
(CONTAR.SI($A$1:$D$6; FILA(INDIRECTO("1:99"))) > 0)
* FILA(INDIRECTO("1:99"));
FILA(INDIRECTO("1:99")))

Saludos y suerte

Luis,

Esta formula es buena para extraer valores repetidos dentro de una sola
hoja. Creo q el problema es un poco mas complejo debido a que hay que
detectar repeticiones no solo (?no tanto?) dentro de una hoja sino tambien
atraves de 19 hojas mas.

Saludos,
KL


"Luis Garcia" wrote in message
news:

"Raúl Z." escribió en...

Hola a todos
Tengo un libro con 20 hojas y en cada hoja tengo 4 columnas con números x

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 número repetidos,
o sea que siguiendo el ej. anterior me diga:

A
1 28
2 32
3 11

Hola Raul: Como estoy aprendiendo a usar formulas matriciales, he probado
y
he conseguido 'algo' que hace algo parecido a lo que buscas, a ver si te
sirve:

Suposicion:, los número están comprendidos entre 1 y 99
NOTA: Selecciona 100 celdas en columna (p.e. F1:F99) y
escribe lo siguiente en la barra de formulas, finalizando con
MAYUS-CTRL-INTRO:

=K.ESIMO.MAYOR(
(CONTAR.SI($A$1:$D$6; FILA(INDIRECTO("1:99"))) > 0)
* FILA(INDIRECTO("1:99"));
FILA(INDIRECTO("1:99")))

Saludos y suerte

"KL" <lapink2000(at)hotmail.com> escribió en...

Luis,
Esta formula es buena para extraer valores repetidos dentro de una sola
hoja. Creo q el problema es un poco mas complejo debido a que hay que
detectar repeticiones no solo (?no tanto?) dentro de una hoja sino tambien
atraves de 19 hojas mas.

Si la formula le sirve, entonces en una hoja nueva copias la formula en las
columnas "1-20" para las 20 hojas (cambiando la referencia de los datos)
y en la columna 22, vuelves a copiar la formula, pero referenciando a las
columnas "1-20" de esta nueva hoja...

eso si, no me responsabilizo del tiempo que tarde en calcularlo todo,
yo solamente estaba aprovechando para practicar con formulas
matriciales :-))))

Saludos

Raul,

Una solucion podria ser la de montar un hoja intermedia q podria ser algo
asi:
[A] [B] [C] [:] [T] [U]
[1] Valor Hoja1 Hoja2 Hoja: Hoja20 Total
[2] 1 0 0 : 0 0
[3] 2 1 0 : 0 1
[4] 3 0 1 : 0 1
[...] : : : : : 0
[100] 99 0 0 : 0 0


En la celda [B2] introduces la siguiente formula y la copias arrastrando
horizontal y verticalmente hasta la [T100]:

=CONTAR.SI(INDIRECTO("'"&C$2&"'!$A$1:$D$3000"),$B3)

En la celda [U2] pones la suma de la fila y la arrastras hacia abajo hasta
la celda [U100]:

=SUMA($B3:$T3)

Finalmente usas la formula q propone Luis, pero ligeramente modificada:

=K.ESIMO.MAYOR((DESREF($A$2:$A$100, 0,20) > 1)*FILA(INDIRECTO("1:99")),
FILA(INDIRECTO("1:99")))

Para introducir esta formula selecciona 100 celdas verticalmente pon el
cursor dentro de la primera celda pega la formula y pulsa MAYUS-CTRL-INTRO

Saludos,
KL

"KL" <lapink2000(at)hotmail.com> wrote in message
news:

Luis,

Esta formula es buena para extraer valores repetidos dentro de una sola
hoja. Creo q el problema es un poco mas complejo debido a que hay que
detectar repeticiones no solo (?no tanto?) dentro de una hoja sino tambien
atraves de 19 hojas mas.

Saludos,
KL


"Luis Garcia" wrote in message
news:

"Raúl Z." escribió en...

Hola a todos
Tengo un libro con 20 hojas y en cada hoja tengo 4 columnas con números
x

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 número
repetidos,
o sea que siguiendo el ej. anterior me diga:

A
1 28
2 32
3 11

Hola Raul: Como estoy aprendiendo a usar formulas matriciales, he probado
y
he conseguido 'algo' que hace algo parecido a lo que buscas, a ver si te
sirve:

Suposicion:, los número están comprendidos entre 1 y 99
NOTA: Selecciona 100 celdas en columna (p.e. F1:F99) y
escribe lo siguiente en la barra de formulas, finalizando con
MAYUS-CTRL-INTRO:

=K.ESIMO.MAYOR(
(CONTAR.SI($A$1:$D$6; FILA(INDIRECTO("1:99"))) > 0)
* FILA(INDIRECTO("1:99"));
FILA(INDIRECTO("1:99")))

Saludos y suerte