Discussion:
Números repetidos
(demasiado antiguo para responder)
Raúl Z.
2004-12-21 16:27:03 UTC
Hola a todos
Tengo un libro con 20 hojas y en cada hoja tengo 4 columnas con números 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 número repetidos, o
sea que siguiendo el ej. anterior me diga:

A
1 28
2 32
3 11

etc.etc.
Muchas gracias
Raúl
"KL" <lapink2000(at)hotmail.com>
2004-12-21 19:26:37 UTC
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---------
Post by Raúl Z.
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
A
1 28
2 32
3 11
etc.etc.
Muchas gracias
Raul
Raúl Z.
2004-12-21 21:43:05 UTC
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.
Post by "KL" <lapink2000(at)hotmail.com>
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
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---------
Post by Raúl Z.
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
A
1 28
2 32
3 11
etc.etc.
Muchas gracias
Raul
Raúl Z.
2004-12-21 21:55:03 UTC
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
Post by "KL" <lapink2000(at)hotmail.com>
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
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---------
Post by Raúl Z.
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
A
1 28
2 32
3 11
etc.etc.
Muchas gracias
Raul
KL
2004-12-21 23:16:13 UTC
Raul,

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

KL
Post by Raúl Z.
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
Post by "KL" <lapink2000(at)hotmail.com>
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
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---------
Post by Raúl Z.
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
A
1 28
2 32
3 11
etc.etc.
Muchas gracias
Raul
"KL" <lapink2000(at)hotmail.com>
2004-12-21 23:57:18 UTC
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---------
Post by KL
Raul,
Tienes razon - no funciona. Voy a ver si se me ocurre otra cosa.
KL
Post by Raúl Z.
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
Post by "KL" <lapink2000(at)hotmail.com>
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
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---------
Post by Raúl Z.
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
A
1 28
2 32
3 11
etc.etc.
Muchas gracias
Raul
KL
2004-12-22 00:59:51 UTC
...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---------
Post by "KL" <lapink2000(at)hotmail.com>
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
' 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---------
Post by KL
Raul,
Tienes razon - no funciona. Voy a ver si se me ocurre otra cosa.
KL
Post by Raúl Z.
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
Post by "KL" <lapink2000(at)hotmail.com>
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
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---------
Post by Raúl Z.
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
A
1 28
2 32
3 11
etc.etc.
Muchas gracias
Raul
Raúl Z.
2004-12-27 10:21:03 UTC
Muchas gracias KL, estoy probando lo tuyo y lo de Daniel M., las 2 funcionan,
pero la de Daniel M. es menos compleja y más simple me parece.
Gracias x tu interés.

Raúl
Post by "KL" <lapink2000(at)hotmail.com>
'---------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
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
' 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---------
Post by "KL" <lapink2000(at)hotmail.com>
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
' 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---------
Post by KL
Raul,
Tienes razon - no funciona. Voy a ver si se me ocurre otra cosa.
KL
Post by Raúl Z.
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
Post by "KL" <lapink2000(at)hotmail.com>
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
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---------
Post by Raúl Z.
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
A
1 28
2 32
3 11
etc.etc.
Muchas gracias
Raul
KL
2004-12-27 10:44:12 UTC
Raul,

Es mas - yo te recomiendo q uses el macro de Daniel M., es mas rapido y mas
elegante.

Saludos,
KL
Post by Raúl Z.
Muchas gracias KL, estoy probando lo tuyo y lo de Daniel M., las 2 funcionan,
pero la de Daniel M. es menos compleja y mas simple me parece.
Gracias x tu interes.
Raul
Post by "KL" <lapink2000(at)hotmail.com>
'---------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
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
' 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---------
Post by "KL" <lapink2000(at)hotmail.com>
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
' 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---------
Post by KL
Raul,
Tienes razon - no funciona. Voy a ver si se me ocurre otra cosa.
KL
Post by Raúl Z.
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
Post by "KL" <lapink2000(at)hotmail.com>
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
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---------
Post by Raúl Z.
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
A
1 28
2 32
3 11
etc.etc.
Muchas gracias
Raul
Luis Garcia
2004-12-22 11:00:01 UTC
Post by Raúl Z.
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,
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>
2004-12-22 11:31:34 UTC
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
Post by Luis Garcia
Post by Raúl Z.
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,
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
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
=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 Garcia
2004-12-22 12:14:54 UTC
"KL" <lapink2000(at)hotmail.com> escribió en...
Post by "KL" <lapink2000(at)hotmail.com>
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
KL
2004-12-22 12:38:58 UTC
Luis,

En este situacion (si se quiere montar toda una matriz intermedia) bastaria
con una simple combinacion de CONTAR.SI e INDIRECTO para contar los valores
repetidos y luego usar una formula matricial en la columna 22 (mira mi
ultimo posting mas arriba)

Saludos,
KL
Post by Luis Garcia
"KL" <lapink2000(at)hotmail.com> escribió en...
Post by "KL" <lapink2000(at)hotmail.com>
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
Raúl Z.
2004-12-27 10:23:03 UTC
Muchas Gracias Luis.

Raúl
Post by Luis Garcia
"KL" <lapink2000(at)hotmail.com> escribió en...
Post by "KL" <lapink2000(at)hotmail.com>
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
KL
2004-12-22 12:32:52 UTC
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
Post by "KL" <lapink2000(at)hotmail.com>
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
Post by Luis Garcia
Post by Raúl Z.
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,
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
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
=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
Daniel.M
2004-12-22 15:14:58 UTC
Hola Raul,

Tiene que tener una hoja que se llama "HojarSumar" para inscribir los
resultados.
La macro siguiente monstra las duplicadas (pero no los errores o celdas vacias).
Puede cambiar el rango (evidamente).


Sub BuscarDuplicadasVariasHojas()
Dim Hoja As Worksheet, C As Range
Dim D As Object, Llaves As Variant, Veces As Variant
Dim res As Variant ' resultado de Match()

Worksheets("HojaSumar").Range("A2:B10000").ClearContents

Set D = CreateObject("Scripting.Dictionary")

For Each Hoja In ThisWorkbook.Worksheets
If Hoja.Name <> "HojaSumar" Then
For Each C In Intersect(Hoja.Range("A:D"), Hoja.UsedRange)
' cambiar el rango si lo quiere
If Not IsError(C.Value) Then ' sin error
If C.Value <> "" Then ' sin vacias
If D.Exists(C.Value) Then
D.Item(C.Value) = D.Item(C.Value) + 1
Else
D.Add C.Value, 1
End If
End If
End If
Next C
End If
Next Hoja

Llaves = D.Keys
Veces = D.Items

'Monstrar resultados
With Worksheets("HojaSumar").Range("A2").Resize(D.Count)
.Value = Application.Transpose(Llaves)
.Offset(0, 1).Value = Application.Transpose(Veces)
.Resize(, 2).Sort key1:=.Cells(1, 2), order1:=xlDescending
res = Application.Match(1, .Offset(0, 1), 0)
If Not IsError(res) Then
.Offset(res - 1, 0).Resize(, 2).ClearContents
End If
End With

Set D = Nothing

End Sub


Saludos,

Daniel M.
Post by Raúl Z.
Hola a todos
Tengo un libro con 20 hojas y en cada hoja tengo 4 columnas con números 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 número repetidos, o
A
1 28
2 32
3 11
etc.etc.
Muchas gracias
Raúl
"KL" <lapink2000(at)hotmail.com>
2004-12-22 15:41:03 UTC
Daniel,

Excelente idea - me encanta. Y es super rapida.

Saludos,
KL
Post by Daniel.M
Hola Raul,
Tiene que tener una hoja que se llama "HojarSumar" para inscribir los
resultados.
La macro siguiente monstra las duplicadas (pero no los errores o celdas vacias).
Puede cambiar el rango (evidamente).
Sub BuscarDuplicadasVariasHojas()
Dim Hoja As Worksheet, C As Range
Dim D As Object, Llaves As Variant, Veces As Variant
Dim res As Variant ' resultado de Match()
Worksheets("HojaSumar").Range("A2:B10000").ClearContents
Set D = CreateObject("Scripting.Dictionary")
For Each Hoja In ThisWorkbook.Worksheets
If Hoja.Name <> "HojaSumar" Then
For Each C In Intersect(Hoja.Range("A:D"), Hoja.UsedRange)
' cambiar el rango si lo quiere
If Not IsError(C.Value) Then ' sin error
If C.Value <> "" Then ' sin vacias
If D.Exists(C.Value) Then
D.Item(C.Value) = D.Item(C.Value) + 1
Else
D.Add C.Value, 1
End If
End If
End If
Next C
End If
Next Hoja
Llaves = D.Keys
Veces = D.Items
'Monstrar resultados
With Worksheets("HojaSumar").Range("A2").Resize(D.Count)
.Value = Application.Transpose(Llaves)
.Offset(0, 1).Value = Application.Transpose(Veces)
.Resize(, 2).Sort key1:=.Cells(1, 2), order1:=xlDescending
res = Application.Match(1, .Offset(0, 1), 0)
If Not IsError(res) Then
.Offset(res - 1, 0).Resize(, 2).ClearContents
End If
End With
Set D = Nothing
End Sub
Saludos,
Daniel M.
Post by Raúl Z.
Hola a todos
Tengo un libro con 20 hojas y en cada hoja tengo 4 columnas con números 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 número repetidos, o
A
1 28
2 32
3 11
etc.etc.
Muchas gracias
Raúl
Daniel.M
2004-12-23 01:02:11 UTC
Post by "KL" <lapink2000(at)hotmail.com>
Excelente idea - me encanta. Y es super rapida.
Saludos,
KL
:-)
Gracias KL.

Daniel M.
Raúl Z.
2004-12-27 10:14:14 UTC
Hola Daniel,
Muchas Gracias
Tu código me parece bastante interesante, lo estoy probando, al igual que el
de Daniel, después veré por cual me decido, ambos funcionan, aunque tengo que
hacerle algunos retoques.
Alguno de ellos es eliminar de la búsqueda determinadas hojas, x ej. la hoja
"Perez" la hoja "Sanchez" etc. tendría que ir aquí no?
If Hoja.Name <> "HojaSumar" Then

Espero tu amable respuesta
Muchas Gracias.
Raúl
Post by Daniel.M
Hola Raul,
Tiene que tener una hoja que se llama "HojarSumar" para inscribir los
resultados.
La macro siguiente monstra las duplicadas (pero no los errores o celdas vacias).
Puede cambiar el rango (evidamente).
Sub BuscarDuplicadasVariasHojas()
Dim Hoja As Worksheet, C As Range
Dim D As Object, Llaves As Variant, Veces As Variant
Dim res As Variant ' resultado de Match()
Worksheets("HojaSumar").Range("A2:B10000").ClearContents
Set D = CreateObject("Scripting.Dictionary")
For Each Hoja In ThisWorkbook.Worksheets
If Hoja.Name <> "HojaSumar" Then
For Each C In Intersect(Hoja.Range("A:D"), Hoja.UsedRange)
' cambiar el rango si lo quiere
If Not IsError(C.Value) Then ' sin error
If C.Value <> "" Then ' sin vacias
If D.Exists(C.Value) Then
D.Item(C.Value) = D.Item(C.Value) + 1
Else
D.Add C.Value, 1
End If
End If
End If
Next C
End If
Next Hoja
Llaves = D.Keys
Veces = D.Items
'Monstrar resultados
With Worksheets("HojaSumar").Range("A2").Resize(D.Count)
.Value = Application.Transpose(Llaves)
.Offset(0, 1).Value = Application.Transpose(Veces)
.Resize(, 2).Sort key1:=.Cells(1, 2), order1:=xlDescending
res = Application.Match(1, .Offset(0, 1), 0)
If Not IsError(res) Then
.Offset(res - 1, 0).Resize(, 2).ClearContents
End If
End With
Set D = Nothing
End Sub
Saludos,
Daniel M.
Post by Raúl Z.
Hola a todos
Tengo un libro con 20 hojas y en cada hoja tengo 4 columnas con números 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 número repetidos, o
A
1 28
2 32
3 11
etc.etc.
Muchas gracias
Raúl
KL
2004-12-27 10:41:50 UTC
Raul,

Prueba la estructura de abajo para excluir las hojas q quieras en la linea 3
(ojo solo es un fragmento del codigo):

Saludos,
KL

For Each Hoja In ThisWorkbook.Worksheets
Select Case Hoja.Name
Case "HojaSumar", "Perez", "Sanchez" 'etc.
Case Else
For Each C In Intersect(Hoja.Range("A:D"), Hoja.UsedRange)
' cambiar el rango si lo quiere
If Not IsError(C.Value) Then ' sin error
If C.Value <> "" Then ' sin vacias
If D.Exists(C.Value) Then
D.Item(C.Value) = D.Item(C.Value) + 1
Else
D.Add C.Value, 1
End If
End If
End If
Next C
End Select
Next Hoja
Post by Raúl Z.
Hola Daniel,
Muchas Gracias
Tu codigo me parece bastante interesante, lo estoy probando, al igual que
el
de Daniel, despues vere por cual me decido, ambos funcionan, aunque tengo
que
hacerle algunos retoques.
Alguno de ellos es eliminar de la busqueda determinadas hojas, x ej. la
hoja
"Perez" la hoja "Sanchez" etc. tendria que ir aqui no?
If Hoja.Name <> "HojaSumar" Then
Espero tu amable respuesta
Muchas Gracias.
Raul
Post by Daniel.M
Hola Raul,
Tiene que tener una hoja que se llama "HojarSumar" para inscribir los
resultados.
La macro siguiente monstra las duplicadas (pero no los errores o celdas vacias).
Puede cambiar el rango (evidamente).
Sub BuscarDuplicadasVariasHojas()
Dim Hoja As Worksheet, C As Range
Dim D As Object, Llaves As Variant, Veces As Variant
Dim res As Variant ' resultado de Match()
Worksheets("HojaSumar").Range("A2:B10000").ClearContents
Set D = CreateObject("Scripting.Dictionary")
For Each Hoja In ThisWorkbook.Worksheets
If Hoja.Name <> "HojaSumar" Then
For Each C In Intersect(Hoja.Range("A:D"), Hoja.UsedRange)
' cambiar el rango si lo quiere
If Not IsError(C.Value) Then ' sin error
If C.Value <> "" Then ' sin vacias
If D.Exists(C.Value) Then
D.Item(C.Value) = D.Item(C.Value) + 1
Else
D.Add C.Value, 1
End If
End If
End If
Next C
End If
Next Hoja
Llaves = D.Keys
Veces = D.Items
'Monstrar resultados
With Worksheets("HojaSumar").Range("A2").Resize(D.Count)
.Value = Application.Transpose(Llaves)
.Offset(0, 1).Value = Application.Transpose(Veces)
.Resize(, 2).Sort key1:=.Cells(1, 2), order1:=xlDescending
res = Application.Match(1, .Offset(0, 1), 0)
If Not IsError(res) Then
.Offset(res - 1, 0).Resize(, 2).ClearContents
End If
End With
Set D = Nothing
End Sub
Saludos,
Daniel M.
Post by Raúl Z.
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
A
1 28
2 32
3 11
etc.etc.
Muchas gracias
Raul
Daniel.M
2004-12-27 15:20:19 UTC
Buen Dia,

Exactamente como KL te lo dijo.

Y tambien, me parece interesante de cambiar ThisWorkbook por ActiveWorkbook

Entonces, aqui tiene una otra version (yo tengo una otra version que funciona
sin el objecto Dictionary si lo quieres):

Sub BuscarDuplicadasVariasHojas()

Dim Hoja As Worksheet, Celda As Range, Resultados As Range
Dim D As Object, LLaves As Variant, Veces As Variant
Dim res As Variant ' resultado de Match()

Set Resultados = Worksheets("HojaSumar").Range("A2:B10000") ' cambiar

Set D = CreateObject("Scripting.Dictionary")

For Each Hoja In ActiveWorkbook.Worksheets
Select Case Hoja.Name
Case "HojaSumar", "Perez", "Sanchez" 'etc.
Case Else
For Each Celda In Intersect(Hoja.Range("A:D"), Hoja.UsedRange)
' cambie el rango si lo quieres
If Not IsError(Celda.Value) Then ' sin celda con error
If Celda.Value <> "" Then ' sin celda vacia
If D.Exists(Celda.Value) Then ' si el valor exista in el
dictionario
D.Item(Celda.Value) = D.Item(Celda.Value) + 1 ' lo
conta una vez mas
Else
D.Add Celda.Value, 1 ' initialmente
End If
End If ' verif sin celda vacia
End If ' verif sin error
Next Celda
End Select ' verif el nombre de la hoja
Next Hoja

'Monstrar resultados
LLaves = D.Keys
Veces = D.Items
Resultados.ClearContents ' borrar resultados viejos

With Resultados.Resize(D.Count, 1)
.Value = Application.Transpose(LLaves) ' columna 1 ==> llaves
.Offset(0, 1).Value = Application.Transpose(Veces) ' column 2 ==> veces
.Resize(, 2).Sort key1:=.Cells(1, 2), order1:=xlDescending, header:=xlNo
res = Application.Match(1, .Offset(0, 1), 0) ' busca primero 1 en veces
If Not IsError(res) Then ' si encontrado 1
' borrar todas filas de los resultados en la cuales
' vemos 1 llave presentada una vez
.Offset(res - 1, 0).Resize(, 2).ClearContents
End If
End With

Set D = Nothing ' cleanup

End Sub
KL
2004-12-27 15:39:42 UTC
Daniel,

A ver la otra version sin Dictionary, me interesa.

Saludos,
KL
Post by Daniel.M
Buen Dia,
Exactamente como KL te lo dijo.
Y tambien, me parece interesante de cambiar ThisWorkbook por
ActiveWorkbook
Entonces, aqui tiene una otra version (yo tengo una otra version que funciona
Sub BuscarDuplicadasVariasHojas()
Dim Hoja As Worksheet, Celda As Range, Resultados As Range
Dim D As Object, LLaves As Variant, Veces As Variant
Dim res As Variant ' resultado de Match()
Set Resultados = Worksheets("HojaSumar").Range("A2:B10000") ' cambiar
Set D = CreateObject("Scripting.Dictionary")
For Each Hoja In ActiveWorkbook.Worksheets
Select Case Hoja.Name
Case "HojaSumar", "Perez", "Sanchez" 'etc.
Case Else
For Each Celda In Intersect(Hoja.Range("A:D"), Hoja.UsedRange)
' cambie el rango si lo quieres
If Not IsError(Celda.Value) Then ' sin celda con error
If Celda.Value <> "" Then ' sin celda vacia
If D.Exists(Celda.Value) Then ' si el valor exista in el
dictionario
D.Item(Celda.Value) = D.Item(Celda.Value) + 1 ' lo
conta una vez mas
Else
D.Add Celda.Value, 1 ' initialmente
End If
End If ' verif sin celda vacia
End If ' verif sin error
Next Celda
End Select ' verif el nombre de la hoja
Next Hoja
'Monstrar resultados
LLaves = D.Keys
Veces = D.Items
Resultados.ClearContents ' borrar resultados viejos
With Resultados.Resize(D.Count, 1)
.Value = Application.Transpose(LLaves) ' columna 1 ==> llaves
.Offset(0, 1).Value = Application.Transpose(Veces) ' column 2 ==> veces
.Resize(, 2).Sort key1:=.Cells(1, 2), order1:=xlDescending,
header:=xlNo
res = Application.Match(1, .Offset(0, 1), 0) ' busca primero 1 en veces
If Not IsError(res) Then ' si encontrado 1
' borrar todas filas de los resultados en la cuales
' vemos 1 llave presentada una vez
.Offset(res - 1, 0).Resize(, 2).ClearContents
End If
End With
Set D = Nothing ' cleanup
End Sub
Daniel.M
2004-12-27 15:58:05 UTC
KL,

Aqui tiene :-)

Saludos,

Daniel M.

Sub BuscarDuplicadasEnVariasHojas()
Dim Hoja As Worksheet, C As Range, Resultados As Range
Dim res As Variant ' resultado de Match()
Dim j As Long
Dim LLaves As Variant, Veces As Variant, Direcciones As Variant

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

j = 0
For Each Hoja In ActiveWorkbook.Worksheets
Select Case Hoja.Name
Case "HojaSumar", "Perez", "Sanchez" 'etc.
Case Else
For Each C In Intersect(Hoja.Range("A:D"), Hoja.UsedRange)
' cambia el rango si lo quieres
If Not IsError(C.Value) Then ' sin celda con error
If C.Value <> "" Then ' sin celda vacia
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
End Select
Next Hoja

'Monstrar resultados
Resultados.ClearContents ' borrar resultados viejos
'

With Resultados.Resize(j, 1)
.Value = Application.Transpose(LLaves) ' columna 1 ==> llaves
.Offset(0, 1).Value = Application.Transpose(Veces) ' column 2 ==> veces
' column 3 ==> direcciones
.Offset(0, 2).Value = Application.Transpose(Direcciones)
.Resize(, 3).Sort key1:=.Cells(1, 2), order1:=xlDescending, header:=xlNo
res = Application.Match(1, .Offset(0, 1), 0) ' busca primero 1 en veces
If Not IsError(res) Then ' si encontrado 1
' cancelar todas filas donde hay 1 vez la llave
.Offset(res - 1, 0).Resize(, 3).ClearContents
End If
End With

End Sub


Private Function LaDireccion(C As Range) As String
Dim s As String, i As Integer
s = C.Address(False, False, xlA1, True)
i = InStr(1, s, "]")
LaDireccion = Mid(s, i + 1)
End Function
KL
2004-12-27 16:27:05 UTC
Gracias,

KL
Post by Daniel.M
KL,
Aqui tiene :-)
Saludos,
Daniel M.
Sub BuscarDuplicadasEnVariasHojas()
Dim Hoja As Worksheet, C As Range, Resultados As Range
Dim res As Variant ' resultado de Match()
Dim j As Long
Dim LLaves As Variant, Veces As Variant, Direcciones As Variant
Set Resultados = Worksheets("HojaSumar").Range("A2:C10000")
j = 0
For Each Hoja In ActiveWorkbook.Worksheets
Select Case Hoja.Name
Case "HojaSumar", "Perez", "Sanchez" 'etc.
Case Else
For Each C In Intersect(Hoja.Range("A:D"), Hoja.UsedRange)
' cambia el rango si lo quieres
If Not IsError(C.Value) Then ' sin celda con error
If C.Value <> "" Then ' sin celda vacia
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
End Select
Next Hoja
'Monstrar resultados
Resultados.ClearContents ' borrar resultados viejos
'
With Resultados.Resize(j, 1)
.Value = Application.Transpose(LLaves) ' columna 1 ==> llaves
.Offset(0, 1).Value = Application.Transpose(Veces) ' column 2 ==> veces
' column 3 ==> direcciones
.Offset(0, 2).Value = Application.Transpose(Direcciones)
.Resize(, 3).Sort key1:=.Cells(1, 2), order1:=xlDescending,
header:=xlNo
res = Application.Match(1, .Offset(0, 1), 0) ' busca primero 1 en veces
If Not IsError(res) Then ' si encontrado 1
' cancelar todas filas donde hay 1 vez la llave
.Offset(res - 1, 0).Resize(, 3).ClearContents
End If
End With
End Sub
Private Function LaDireccion(C As Range) As String
Dim s As String, i As Integer
s = C.Address(False, False, xlA1, True)
i = InStr(1, s, "]")
LaDireccion = Mid(s, i + 1)
End Function
Raúl Z.
2004-12-27 19:17:03 UTC
Hola Daniel
Muchas gracias.
Me dá un error en:
.Offset(0, 2).Value = Application.Transpose(Direcciones)
Estoy usando la versión sin Dictionary.

Raúl
Post by Daniel.M
KL,
Aqui tiene :-)
Saludos,
Daniel M.
Sub BuscarDuplicadasEnVariasHojas()
Dim Hoja As Worksheet, C As Range, Resultados As Range
Dim res As Variant ' resultado de Match()
Dim j As Long
Dim LLaves As Variant, Veces As Variant, Direcciones As Variant
Set Resultados = Worksheets("HojaSumar").Range("A2:C10000")
j = 0
For Each Hoja In ActiveWorkbook.Worksheets
Select Case Hoja.Name
Case "HojaSumar", "Perez", "Sanchez" 'etc.
Case Else
For Each C In Intersect(Hoja.Range("A:D"), Hoja.UsedRange)
' cambia el rango si lo quieres
If Not IsError(C.Value) Then ' sin celda con error
If C.Value <> "" Then ' sin celda vacia
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
End Select
Next Hoja
'Monstrar resultados
Resultados.ClearContents ' borrar resultados viejos
'
With Resultados.Resize(j, 1)
.Value = Application.Transpose(LLaves) ' columna 1 ==> llaves
.Offset(0, 1).Value = Application.Transpose(Veces) ' column 2 ==> veces
' column 3 ==> direcciones
.Offset(0, 2).Value = Application.Transpose(Direcciones)
.Resize(, 3).Sort key1:=.Cells(1, 2), order1:=xlDescending, header:=xlNo
res = Application.Match(1, .Offset(0, 1), 0) ' busca primero 1 en veces
If Not IsError(res) Then ' si encontrado 1
' cancelar todas filas donde hay 1 vez la llave
.Offset(res - 1, 0).Resize(, 3).ClearContents
End If
End With
End Sub
Private Function LaDireccion(C As Range) As String
Dim s As String, i As Integer
s = C.Address(False, False, xlA1, True)
i = InStr(1, s, "]")
LaDireccion = Mid(s, i + 1)
End Function
Daniel.M
2004-12-27 20:22:20 UTC
Hola,
Post by Raúl Z.
Muchas gracias.
De nada, Raul.
Post by Raúl Z.
.Offset(0, 2).Value = Application.Transpose(Direcciones)
Estoy usando la versión sin Dictionary.
Y como el codigo siguiente, funciona?

Daniel M.

Sub BuscarDuplicadasEnVariasHojas()
Dim Hoja As Worksheet, C As Range, Resultados As Range
Dim res As Variant ' resultado de Match()
Dim j As Long, i As Long, k As Long
Dim LLaves As Variant, Veces As Variant, Direcciones As Variant

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

j = 0
For Each Hoja In ActiveWorkbook.Worksheets
Select Case Hoja.Name
Case "HojaSumar", "Perez", "Sanchez" 'etc.
Case Else
For Each C In Intersect(Hoja.Range("A:D"), Hoja.UsedRange)
' cambia el rango si lo quieres
If Not IsError(C.Value) Then ' sin celda con error
If C.Value <> "" Then ' sin celda vacia
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
End Select
Next Hoja

'Monstrar resultados
Resultados.ClearContents ' borrar resultados viejos
'
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, i As Integer
s = C.Address(False, False, xlA1, True)
i = InStr(1, s, "]")
LaDireccion = Mid(s, i + 1)
End Function
Raúl Z.
2004-12-27 19:55:05 UTC
Por fin anduvo esto Daniel
Muchiiiiiiiiiiiiiiiiisimas gracias al igual que al amigo KL que siempre se
interesó
Solo tuve que hacerle una correción y es agregar:
Worksheets("HojaSumar").Range("A2:B10000").ClearContents
Porque sino me sumaba la cantidad de repetidos como números repetidos, se
entiende?
Muchas gracias y adios.

Raúl Z.
Post by Daniel.M
Buen Dia,
Exactamente como KL te lo dijo.
Y tambien, me parece interesante de cambiar ThisWorkbook por ActiveWorkbook
Entonces, aqui tiene una otra version (yo tengo una otra version que funciona
Sub BuscarDuplicadasVariasHojas()
Dim Hoja As Worksheet, Celda As Range, Resultados As Range
Dim D As Object, LLaves As Variant, Veces As Variant
Dim res As Variant ' resultado de Match()
Set Resultados = Worksheets("HojaSumar").Range("A2:B10000") ' cambiar
Set D = CreateObject("Scripting.Dictionary")
For Each Hoja In ActiveWorkbook.Worksheets
Select Case Hoja.Name
Case "HojaSumar", "Perez", "Sanchez" 'etc.
Case Else
For Each Celda In Intersect(Hoja.Range("A:D"), Hoja.UsedRange)
' cambie el rango si lo quieres
If Not IsError(Celda.Value) Then ' sin celda con error
If Celda.Value <> "" Then ' sin celda vacia
If D.Exists(Celda.Value) Then ' si el valor exista in el
dictionario
D.Item(Celda.Value) = D.Item(Celda.Value) + 1 ' lo
conta una vez mas
Else
D.Add Celda.Value, 1 ' initialmente
End If
End If ' verif sin celda vacia
End If ' verif sin error
Next Celda
End Select ' verif el nombre de la hoja
Next Hoja
'Monstrar resultados
LLaves = D.Keys
Veces = D.Items
Resultados.ClearContents ' borrar resultados viejos
With Resultados.Resize(D.Count, 1)
.Value = Application.Transpose(LLaves) ' columna 1 ==> llaves
.Offset(0, 1).Value = Application.Transpose(Veces) ' column 2 ==> veces
.Resize(, 2).Sort key1:=.Cells(1, 2), order1:=xlDescending, header:=xlNo
res = Application.Match(1, .Offset(0, 1), 0) ' busca primero 1 en veces
If Not IsError(res) Then ' si encontrado 1
' borrar todas filas de los resultados en la cuales
' vemos 1 llave presentada una vez
.Offset(res - 1, 0).Resize(, 2).ClearContents
End If
End With
Set D = Nothing ' cleanup
End Sub
KL
2004-12-27 21:30:26 UTC
Post by Raúl Z.
Muchiiiiiiiiiiiiiiiiisimas gracias al igual que al amigo KL que siempre se
intereso
Un placer.
Post by Raúl Z.
Worksheets("HojaSumar").Range("A2:B10000").ClearContents
Pues si, creo q se nos habia escapado este detalle.

Felices fiestas!
KL
Daniel.M
2004-12-27 23:59:13 UTC
Hola,
Post by KL
Post by Daniel.M
Worksheets("HojaSumar").Range("A2:B10000").ClearContents
Pues si, creo q se nos habia escapado este detalle.
Hay la fila:

Resultados.ClearContents

que lo hace (o yo no entendi bien ==> muy posible :-) ).

Saludos,

Daniel M.
KL
2004-12-28 00:10:11 UTC
Post by Daniel.M
Post by KL
Pues si, creo q se nos habia escapado este detalle.
Resultados.ClearContents
Si, tienes razon :-( Me apresure a reconocer el error, pero en mi codigo yo
tambien habia incluido la linea :-)
RangoExtracto.CurrentRegion.ClearContents

Un abrazo,
KL
Raúl Z.
2004-12-28 00:15:04 UTC
Para terminar con esto y para que quede MAS QUE BIEN,
me gustaría contar todas los número de la columna B en todas las hojas, por
supuesto que obviando las que no quiero.
probé:

Range("F9").Select
ActiveCell.FormulaR1C1 = "=COUNT(R[-8]C[-4]:R[291]C[-4])"
Range("F9").Select

pero solo me suma lo de la hoja "hojasumar"

Muchas gracias desde ya.

Saludos

Raul Z.
quisiera tener este resultado en la hoja "
Post by Daniel.M
Hola,
Post by KL
Post by Daniel.M
Worksheets("HojaSumar").Range("A2:B10000").ClearContents
Pues si, creo q se nos habia escapado este detalle.
Resultados.ClearContents
que lo hace (o yo no entendi bien ==> muy posible :-) ).
Saludos,
Daniel M.
KL
2004-12-28 00:34:08 UTC
Raul,

Prueba una de estas.

Saludos,
KL

'---------Inicio Codigo---------
Sub test()
Dim nPrimeraHoja As String
Dim nUltimaHoja As String
Dim miRango As String

nPrimeraHoja = "Hoja1"
nUltimaHoja = "Hoja22"
miRango = "B1:B300"
miFormula = "=COUNT('" & nPrimeraHoja & ":" & _
nUltimaHoja & "'!" & miRango & ")"

Sheets("hojasumar").Range("F9").Formula = miFormula
End Sub

Sub test2()
Dim nPrimeraHoja As String
Dim nUltimaHoja As String
Dim miRango As String

nPrimeraHoja = "Hoja1"
nUltimaHoja = "Hoja22"
miRango = "B1:B300"
miFormula = "=COUNT('" & nPrimeraHoja & ":" & _
nUltimaHoja & "'!" & miRango & ")"

Sheets("hojasumar").Range("F9") = Evaluate(miFormula)
End Sub
'---------Fin Codigo---------
Post by Raúl Z.
Para terminar con esto y para que quede MAS QUE BIEN,
me gustaria contar todas los numero de la columna B en todas las hojas,
por
supuesto que obviando las que no quiero.
Range("F9").Select
ActiveCell.FormulaR1C1 = "=COUNT(R[-8]C[-4]:R[291]C[-4])"
Range("F9").Select
pero solo me suma lo de la hoja "hojasumar"
Muchas gracias desde ya.
Saludos
Raul Z.
quisiera tener este resultado en la hoja "
Post by Daniel.M
Hola,
Post by KL
Post by Daniel.M
Worksheets("HojaSumar").Range("A2:B10000").ClearContents
Pues si, creo q se nos habia escapado este detalle.
Resultados.ClearContents
que lo hace (o yo no entendi bien ==> muy posible :-) ).
Saludos,
Daniel M.
Raúl Z.
2004-12-28 23:23:01 UTC
Gracias KL.
La segunda andubo muy bien, ahora tengo un pequeñito problema por el que
tengo que agrupar al finar las hojas que no quiero sumar, que son las mismas
de los número repetidos, se puede asociar esta macro con la de repetidos y
que tome estos? se entiende?
Gracias
Raúl Z.
Post by KL
Raul,
Prueba una de estas.
Saludos,
KL
'---------Inicio Codigo---------
Sub test()
Dim nPrimeraHoja As String
Dim nUltimaHoja As String
Dim miRango As String
nPrimeraHoja = "Hoja1"
nUltimaHoja = "Hoja22"
miRango = "B1:B300"
miFormula = "=COUNT('" & nPrimeraHoja & ":" & _
nUltimaHoja & "'!" & miRango & ")"
Sheets("hojasumar").Range("F9").Formula = miFormula
End Sub
Sub test2()
Dim nPrimeraHoja As String
Dim nUltimaHoja As String
Dim miRango As String
nPrimeraHoja = "Hoja1"
nUltimaHoja = "Hoja22"
miRango = "B1:B300"
miFormula = "=COUNT('" & nPrimeraHoja & ":" & _
nUltimaHoja & "'!" & miRango & ")"
Sheets("hojasumar").Range("F9") = Evaluate(miFormula)
End Sub
'---------Fin Codigo---------
Post by Raúl Z.
Para terminar con esto y para que quede MAS QUE BIEN,
me gustaria contar todas los numero de la columna B en todas las hojas,
por
supuesto que obviando las que no quiero.
Range("F9").Select
ActiveCell.FormulaR1C1 = "=COUNT(R[-8]C[-4]:R[291]C[-4])"
Range("F9").Select
pero solo me suma lo de la hoja "hojasumar"
Muchas gracias desde ya.
Saludos
Raul Z.
quisiera tener este resultado en la hoja "
Post by Daniel.M
Hola,
Post by KL
Post by Daniel.M
Worksheets("HojaSumar").Range("A2:B10000").ClearContents
Pues si, creo q se nos habia escapado este detalle.
Resultados.ClearContents
que lo hace (o yo no entendi bien ==> muy posible :-) ).
Saludos,
Daniel M.
KL
2004-12-28 23:35:49 UTC
La segunda andubo muy bien, ahora tengo un pequenito problema por el que
tengo que agrupar al finar las hojas que no quiero sumar, que son las mismas
de los numero repetidos, se puede asociar esta macro con la de repetidos y
que tome estos? se entiende?
La verdad es q no mucho. ?Puedes explicarlo con un poco mas de detalle?

Saludos,
KL
Raúl Z.
2004-12-29 06:33:02 UTC
Haber si soy claro en esta oportunidad K.L.
Te decía que la segunda opción fué la que funcionó bien.
El tema es que tengo que agrupar al final del libro las hojas q no quiero
sumar
por ej. tengo las hojas "pedro", "juan", "josé, "mariano", "claudio" pero
resulta q quiero sumar solo "pedro", "mariano", "claudio" entonces lo que
tengo que hacer es mover manualmente a "juan", "josé", para que lo macro tome
como primera hoja a "pedro" y como última a "claudio",
Hasta aquí bien?
Bueno, lo que preguntaba es si hay alguna forma de incluírlo en la macro de
los números repetidos, ya que las que hojas que no se deben sumar son las que
excluímos en:
Case "HojaSumar", "Perez", "Sanchez" 'etc.
Case Else
recuerdas ?

Y por último te decia que esta macro quiero que esté dentro de la macro de
números repetidos.

Espero haber sido claro
Muchas Gracias

Raúl Z.
Post by KL
La segunda andubo muy bien, ahora tengo un pequenito problema por el que
tengo que agrupar al finar las hojas que no quiero sumar, que son las mismas
de los numero repetidos, se puede asociar esta macro con la de repetidos y
que tome estos? se entiende?
La verdad es q no mucho. ?Puedes explicarlo con un poco mas de detalle?
Saludos,
KL
KL
2004-12-29 10:13:50 UTC
Raul,

Ahora si! A ver, prueba el codigo de abajo. Ojo-no lo he probado, pero creo
q deberia funcionar. De todas formas me dices si hay problemas. He puesto
mis comentarios precedidos por "KL:".

Saludos,
KL

'------Inicio Codigo-------
Sub BuscarDuplicadasEnVariasHojas()
Dim Hoja As Worksheet, C As Range, Resultados As Range
Dim res As Variant ' resultado de Match()
Dim j As Long, i As Long, k As Long
Dim LLaves As Variant, Veces As Variant, Direcciones As Variant
Dim miRng As Range 'KL: variable para el rango a evaluar.
Dim Contador As Single 'KL: variable para la cuenta de valores.

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

j = 0
For Each Hoja In ActiveWorkbook.Worksheets
Select Case Hoja.Name
Case "HojaSumar", "Perez", "Sanchez" 'etc.
Case Else
'KL: Establece el rango a evaluar para la hoja.
Set miRng = Intersect(Hoja.Range("A:D"), _
Hoja.UsedRange).Offset(1, 0).Resize(rng.Rows.Count - 1)

'Actualiza la cuenta de valores para cada hoja.
Contador = Contador + WorksheetFunction.Count(miRng)

For Each C In miRng
' cambia el rango si lo quieres
If Not IsError(C.Value) Then ' sin celda con error
If C.Value <> "" Then ' sin celda vacia
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
End Select
Next Hoja

'Mostrar los resultados
Resultados.ClearContents ' borrar resultados viejos
'
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

'KL: Asigna la cuenta total de valores a
'la celda F9 de la hoja "hojasumar"
Sheets("hojasumar").Range("F9") = Contador
End Sub


Private Function LaDireccion(C As Range) As String
Dim s As String, i As Integer
s = C.Address(False, False, xlA1, True)
i = InStr(1, s, "]")
LaDireccion = Mid(s, i + 1)
End Function
'------Fin Codigo-------
Post by Raúl Z.
Haber si soy claro en esta oportunidad K.L.
Te decia que la segunda opcion fue la que funciono bien.
El tema es que tengo que agrupar al final del libro las hojas q no quiero
sumar
por ej. tengo las hojas "pedro", "juan", "jose, "mariano", "claudio" pero
resulta q quiero sumar solo "pedro", "mariano", "claudio" entonces lo que
tengo que hacer es mover manualmente a "juan", "jose", para que lo macro
tome
como primera hoja a "pedro" y como ultima a "claudio",
Hasta aqui bien?
Bueno, lo que preguntaba es si hay alguna forma de incluirlo en la macro
de
los numeros repetidos, ya que las que hojas que no se deben sumar son las
que
Case "HojaSumar", "Perez", "Sanchez" 'etc.
Case Else
recuerdas ?
Y por ultimo te decia que esta macro quiero que este dentro de la macro de
numeros repetidos.
Espero haber sido claro
Muchas Gracias
Raul Z.
Post by KL
La segunda andubo muy bien, ahora tengo un pequenito problema por el que
tengo que agrupar al finar las hojas que no quiero sumar, que son las mismas
de los numero repetidos, se puede asociar esta macro con la de repetidos y
que tome estos? se entiende?
La verdad es q no mucho. ?Puedes explicarlo con un poco mas de detalle?
Saludos,
KL
KL
2004-12-29 10:33:20 UTC
Raul,

Por si acaso he probado el codigo y he detectado un pequeno error. Tendras q
Post by KL
'KL: Establece el rango a evaluar para la hoja.
Set miRng = Intersect(Hoja.Range("A:D"), _
Hoja.UsedRange).Offset(1, 0).Resize(rng.Rows.Count - 1)
con:

'KL: Establece el rango a evaluar para la hoja.
With Intersect(Hoja.Range("A:D"), Hoja.UsedRange)
Set miRng = .Offset(1, 0).Resize(.Rows.Count - 1)
End With

Saludos,
KL
(XL 97, 2000, 2002)
------------
Ojo - mi separador de argumentos en las formulas es la coma ",".
Puede q necesites cambiarla por punto y coma ";".

Para usar mi direccion de correo electronico privada
borra "NOSPAM" y "PLEASE" antes de usarla.
------------
Post by KL
Raul,
Ahora si! A ver, prueba el codigo de abajo. Ojo-no lo he probado, pero
creo q deberia funcionar. De todas formas me dices si hay problemas. He
puesto mis comentarios precedidos por "KL:".
Saludos,
KL
'------Inicio Codigo-------
Sub BuscarDuplicadasEnVariasHojas()
Dim Hoja As Worksheet, C As Range, Resultados As Range
Dim res As Variant ' resultado de Match()
Dim j As Long, i As Long, k As Long
Dim LLaves As Variant, Veces As Variant, Direcciones As Variant
Dim miRng As Range 'KL: variable para el rango a evaluar.
Dim Contador As Single 'KL: variable para la cuenta de valores.
Set Resultados = Worksheets("HojaSumar").Range("A2:C10000")
j = 0
For Each Hoja In ActiveWorkbook.Worksheets
Select Case Hoja.Name
Case "HojaSumar", "Perez", "Sanchez" 'etc.
Case Else
'KL: Establece el rango a evaluar para la hoja.
Set miRng = Intersect(Hoja.Range("A:D"), _
Hoja.UsedRange).Offset(1, 0).Resize(rng.Rows.Count - 1)
'Actualiza la cuenta de valores para cada hoja.
Contador = Contador + WorksheetFunction.Count(miRng)
For Each C In miRng
' cambia el rango si lo quieres
If Not IsError(C.Value) Then ' sin celda con error
If C.Value <> "" Then ' sin celda vacia
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
End Select
Next Hoja
'Mostrar los resultados
Resultados.ClearContents ' borrar resultados viejos
'
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
'KL: Asigna la cuenta total de valores a
'la celda F9 de la hoja "hojasumar"
Sheets("hojasumar").Range("F9") = Contador
End Sub
Private Function LaDireccion(C As Range) As String
Dim s As String, i As Integer
s = C.Address(False, False, xlA1, True)
i = InStr(1, s, "]")
LaDireccion = Mid(s, i + 1)
End Function
'------Fin Codigo-------
Post by Raúl Z.
Haber si soy claro en esta oportunidad K.L.
Te decia que la segunda opcion fue la que funciono bien.
El tema es que tengo que agrupar al final del libro las hojas q no quiero
sumar
por ej. tengo las hojas "pedro", "juan", "jose, "mariano", "claudio" pero
resulta q quiero sumar solo "pedro", "mariano", "claudio" entonces lo que
tengo que hacer es mover manualmente a "juan", "jose", para que lo macro
tome
como primera hoja a "pedro" y como ultima a "claudio",
Hasta aqui bien?
Bueno, lo que preguntaba es si hay alguna forma de incluirlo en la macro
de
los numeros repetidos, ya que las que hojas que no se deben sumar son las
que
Case "HojaSumar", "Perez", "Sanchez" 'etc.
Case Else
recuerdas ?
Y por ultimo te decia que esta macro quiero que este dentro de la macro de
numeros repetidos.
Espero haber sido claro
Muchas Gracias
Raul Z.
Post by KL
La segunda andubo muy bien, ahora tengo un pequenito problema por el que
tengo que agrupar al finar las hojas que no quiero sumar, que son las mismas
de los numero repetidos, se puede asociar esta macro con la de repetidos y
que tome estos? se entiende?
La verdad es q no mucho. ?Puedes explicarlo con un poco mas de detalle?
Saludos,
KL
Raúl Z.
2004-12-29 20:59:03 UTC
Hola K.L.
Efectivamente sustituyendo estas líneas funciona perfectamente.
Además, inserte

Worksheets("HojaSumar").Range("A1:z1000").ClearContents

al comienzo porque sumala esta hoja, analizando el código creia que:

Resultados.ClearContents

borraba todo los resultados, pero no tiene ningun efecto.
Muchisimas gracias esto quedo muy bien, y gracias tambien a todos los que se
interesaron por mi pregunta.

Raúl Z.
Post by KL
Raul,
Por si acaso he probado el codigo y he detectado un pequeno error. Tendras q
Post by KL
'KL: Establece el rango a evaluar para la hoja.
Set miRng = Intersect(Hoja.Range("A:D"), _
Hoja.UsedRange).Offset(1, 0).Resize(rng.Rows.Count - 1)
'KL: Establece el rango a evaluar para la hoja.
With Intersect(Hoja.Range("A:D"), Hoja.UsedRange)
Set miRng = .Offset(1, 0).Resize(.Rows.Count - 1)
End With
Saludos,
KL
(XL 97, 2000, 2002)
------------
Ojo - mi separador de argumentos en las formulas es la coma ",".
Puede q necesites cambiarla por punto y coma ";".
Para usar mi direccion de correo electronico privada
borra "NOSPAM" y "PLEASE" antes de usarla.
------------
Post by KL
Raul,
Ahora si! A ver, prueba el codigo de abajo. Ojo-no lo he probado, pero
creo q deberia funcionar. De todas formas me dices si hay problemas. He
puesto mis comentarios precedidos por "KL:".
Saludos,
KL
'------Inicio Codigo-------
Sub BuscarDuplicadasEnVariasHojas()
Dim Hoja As Worksheet, C As Range, Resultados As Range
Dim res As Variant ' resultado de Match()
Dim j As Long, i As Long, k As Long
Dim LLaves As Variant, Veces As Variant, Direcciones As Variant
Dim miRng As Range 'KL: variable para el rango a evaluar.
Dim Contador As Single 'KL: variable para la cuenta de valores.
Set Resultados = Worksheets("HojaSumar").Range("A2:C10000")
j = 0
For Each Hoja In ActiveWorkbook.Worksheets
Select Case Hoja.Name
Case "HojaSumar", "Perez", "Sanchez" 'etc.
Case Else
'KL: Establece el rango a evaluar para la hoja.
Set miRng = Intersect(Hoja.Range("A:D"), _
Hoja.UsedRange).Offset(1, 0).Resize(rng.Rows.Count - 1)
'Actualiza la cuenta de valores para cada hoja.
Contador = Contador + WorksheetFunction.Count(miRng)
For Each C In miRng
' cambia el rango si lo quieres
If Not IsError(C.Value) Then ' sin celda con error
If C.Value <> "" Then ' sin celda vacia
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
End Select
Next Hoja
'Mostrar los resultados
Resultados.ClearContents ' borrar resultados viejos
'
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
'KL: Asigna la cuenta total de valores a
'la celda F9 de la hoja "hojasumar"
Sheets("hojasumar").Range("F9") = Contador
End Sub
Private Function LaDireccion(C As Range) As String
Dim s As String, i As Integer
s = C.Address(False, False, xlA1, True)
i = InStr(1, s, "]")
LaDireccion = Mid(s, i + 1)
End Function
'------Fin Codigo-------
Post by Raúl Z.
Haber si soy claro en esta oportunidad K.L.
Te decia que la segunda opcion fue la que funciono bien.
El tema es que tengo que agrupar al final del libro las hojas q no quiero
sumar
por ej. tengo las hojas "pedro", "juan", "jose, "mariano", "claudio" pero
resulta q quiero sumar solo "pedro", "mariano", "claudio" entonces lo que
tengo que hacer es mover manualmente a "juan", "jose", para que lo macro
tome
como primera hoja a "pedro" y como ultima a "claudio",
Hasta aqui bien?
Bueno, lo que preguntaba es si hay alguna forma de incluirlo en la macro
de
los numeros repetidos, ya que las que hojas que no se deben sumar son las
que
Case "HojaSumar", "Perez", "Sanchez" 'etc.
Case Else
recuerdas ?
Y por ultimo te decia que esta macro quiero que este dentro de la macro de
numeros repetidos.
Espero haber sido claro
Muchas Gracias
Raul Z.
Post by KL
La segunda andubo muy bien, ahora tengo un pequenito problema por el que
tengo que agrupar al finar las hojas que no quiero sumar, que son las mismas
de los numero repetidos, se puede asociar esta macro con la de repetidos y
que tome estos? se entiende?
La verdad es q no mucho. ?Puedes explicarlo con un poco mas de detalle?
Saludos,
KL
KL
2004-12-29 21:29:20 UTC
Raul,
creia que:.. Resultados.ClearContents
borraba todo los resultados, pero no tiene ningun efecto.
?Estas seguro? a mi si q me funciona a la perfeccion. Yo q tu lo comprobaba
una vez mas, por ejemplo: si el resultado de la ultima extraccion ha sido
digamos 100 filas en la hoja "HojaSumar", copia la ultima fila hacia abajo
hasta la fila digamos 110 y vuelve a usar el macro. Si el resultado velve a
ser 100 filas, entonces si q se borran los datos anteriores.

o

reduce el numero de valores repetidos, p.ej. algo tan drastico como dejando
solo 2 o 3 filas en cada una de las hojas de origen, y vuelve a usar el
macro. Si el numero de filas en la hoja "HojaSumar" sigue siendo 100
entonces probablemente tengamos un problema.

De todas formas, por puro perfeccionismo :-), yo sustituiria la linea:

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

con:

With Worksheets("HojaSumar").UsedRange
Set Resultados = .Offset(1, 0).Resize(.Rows.Count - 1)
End With

Saludos,
KL
Raúl Z.
2004-12-30 12:03:01 UTC
Hola K.L.
Post by Daniel.M
Set Resultados = Worksheets("HojaSumar").Range("A2:C10000")
With Worksheets("HojaSumar").UsedRange
Set Resultados = .Offset(1, 0).Resize(.Rows.Count - 1)
End With
me da error en:
Resultados.Resize(k, 3).Sort key1:=Resultados.Cells(1, 2),
order1:=xlDescending, header:=xlNo

Por otra parte:
Resultados.ClearContents
Borra los resultado no repetidos pero muestra como repetidos los que están
dentro de "hojasumar"

Y...
Otra pregunta fuera de esto:
Existe algún compilador de libros de excel, para que me genere un .exe y lo
pueda usar una pesona sin necesidad de tener el excel instalado?

Gracias

Raúl
Post by Daniel.M
Raul,
creia que:.. Resultados.ClearContents
borraba todo los resultados, pero no tiene ningun efecto.
?Estas seguro? a mi si q me funciona a la perfeccion. Yo q tu lo comprobaba
una vez mas, por ejemplo: si el resultado de la ultima extraccion ha sido
digamos 100 filas en la hoja "HojaSumar", copia la ultima fila hacia abajo
hasta la fila digamos 110 y vuelve a usar el macro. Si el resultado velve a
ser 100 filas, entonces si q se borran los datos anteriores.
o
reduce el numero de valores repetidos, p.ej. algo tan drastico como dejando
solo 2 o 3 filas en cada una de las hojas de origen, y vuelve a usar el
macro. Si el numero de filas en la hoja "HojaSumar" sigue siendo 100
entonces probablemente tengamos un problema.
Set Resultados = Worksheets("HojaSumar").Range("A2:C10000")
With Worksheets("HojaSumar").UsedRange
Set Resultados = .Offset(1, 0).Resize(.Rows.Count - 1)
End With
Saludos,
KL
KL
2004-12-30 17:11:36 UTC
Raul,
Post by Daniel.M
Post by Daniel.M
Set Resultados = Worksheets("HojaSumar").Range("A2:C10000")
With Worksheets("HojaSumar").UsedRange
Set Resultados = .Offset(1, 0).Resize(.Rows.Count - 1)
End With
Resultados.Resize(k, 3).Sort key1:=Resultados.Cells(1, 2),
order1:=xlDescending, header:=xlNo
Tienes razon, habria q cambiar mas cosas en el codigo por lo cual q casi es
mejor dejarlo tal cual.
Post by Daniel.M
Resultados.ClearContents
Borra los resultado no repetidos pero muestra como repetidos los que estan
dentro de "hojasumar"
No he podido detectar nada parecido a lo q dices. ?Como sabes q lo hace?
?Puedes copiar aqui el codigo final q usas o incluso enviarme tu hoja?
Post by Daniel.M
Existe algun compilador de libros de excel, para que me genere un .exe y
lo
pueda usar una pesona sin necesidad de tener el excel instalado?
Nunca lo he hecho, pero seguramente hay alguna forma. Yo q tu lo posteaba
como un tema aparte.

Saludos,
KL
Raúl Z.
2004-12-30 18:01:04 UTC
En cuanto a la corrección la dejo tal cual.
Post by Daniel.M
Resultados.ClearContents
Borra los resultado no repetidos pero muestra como repetidos los que estan
dentro de "hojasumar"
Te reitero que lo tengo solucionado mediante
Worksheets("HojaSumar").Range("A1:z1000").ClearContents
al comenzar la macro.
Podría enviarte la hoja, pero decime una dirección.-

Saludos y muchas gracias por tu interés y ayuda.
atte.
Raúl
Post by Daniel.M
Raul,
Post by Daniel.M
Post by Daniel.M
Set Resultados = Worksheets("HojaSumar").Range("A2:C10000")
With Worksheets("HojaSumar").UsedRange
Set Resultados = .Offset(1, 0).Resize(.Rows.Count - 1)
End With
Resultados.Resize(k, 3).Sort key1:=Resultados.Cells(1, 2),
order1:=xlDescending, header:=xlNo
Tienes razon, habria q cambiar mas cosas en el codigo por lo cual q casi es
mejor dejarlo tal cual.
Post by Daniel.M
Resultados.ClearContents
Borra los resultado no repetidos pero muestra como repetidos los que estan
dentro de "hojasumar"
No he podido detectar nada parecido a lo q dices. ?Como sabes q lo hace?
?Puedes copiar aqui el codigo final q usas o incluso enviarme tu hoja?
Post by Daniel.M
Existe algun compilador de libros de excel, para que me genere un .exe y
lo
pueda usar una pesona sin necesidad de tener el excel instalado?
Nunca lo he hecho, pero seguramente hay alguna forma. Yo q tu lo posteaba
como un tema aparte.
Saludos,
KL