Macro buscar
Estimada Elsa, tengo esta macro que ordena por fila y borra los repetidos y que trabaja bien, gracias a ty, pero necesariamente tiene que ordenar las filas o no encontrara nada.
Range("a1").Select
Do While ActiveCell <> Empty
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(-1, 0).Select
ActiveCell.Offset(0, 1).Select
celdaactiva = ActiveCell.Address
Range("a1:" + celdaactiva).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
contador = 0
Valor = ActiveCell.Value
ActiveCell.Offset(1, 0).Range("A1").Select
While ActiveCell.Value <> ""
If ActiveCell.Value = Valor Then
Selection.EntireRow.Interior.ColorIndex = 42
contador = contador + 1
Else
Valor = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
End If
Wend
Respuesta = MsgBox("Se han encontrado " & contador & " elementos repetidos", 1, "Número de repetidos")
Range("a1").Select
End Sub
Quisiera ver como puede encontrar duplicados sin que tenga que estar en la fila de abajo, así ya no se ordenaría y tendría una macro más liviana.
Yo ya lo intente pero no lo conseguí, es así que nuevamente recurro a tu ayuda.
Gracias nuevamente
Saludos Ernesto
Range("a1").Select
Do While ActiveCell <> Empty
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(-1, 0).Select
ActiveCell.Offset(0, 1).Select
celdaactiva = ActiveCell.Address
Range("a1:" + celdaactiva).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
contador = 0
Valor = ActiveCell.Value
ActiveCell.Offset(1, 0).Range("A1").Select
While ActiveCell.Value <> ""
If ActiveCell.Value = Valor Then
Selection.EntireRow.Interior.ColorIndex = 42
contador = contador + 1
Else
Valor = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
End If
Wend
Respuesta = MsgBox("Se han encontrado " & contador & " elementos repetidos", 1, "Número de repetidos")
Range("a1").Select
End Sub
Quisiera ver como puede encontrar duplicados sin que tenga que estar en la fila de abajo, así ya no se ordenaría y tendría una macro más liviana.
Yo ya lo intente pero no lo conseguí, es así que nuevamente recurro a tu ayuda.
Gracias nuevamente
Saludos Ernesto
1 respuesta
Respuesta de Elsa Matilde
1
Para esto no necesitarías una rutina si pudieras contar con una col auxiliar donde colocar una fórmula que dará 0 si no está repetido.
Luego podes utilizar un filtro para obtener los de valor <> 0.
También podes tener una rutina que te recorra esa col aux pintando la que tenga valores <> 0 o que pinte las celdas filtradas.
La fórmula a utilizar será:
=contar.si($A2:$A200;A2)
Ajustá tu rango y arrastrá al resto.
Espero tus comentarios.
Luego podes utilizar un filtro para obtener los de valor <> 0.
También podes tener una rutina que te recorra esa col aux pintando la que tenga valores <> 0 o que pinte las celdas filtradas.
La fórmula a utilizar será:
=contar.si($A2:$A200;A2)
Ajustá tu rango y arrastrá al resto.
Espero tus comentarios.
Hola
La respuesta es valida pero no me serviría donde deseo aplicarla, que es en un txt para que al introducir un nº de factura desde el formulario revise en la columna y si ya fue introducida me avise con un mensaje.
Gracias y espero tu respuesta
Saludos
Ernesto
La respuesta es valida pero no me serviría donde deseo aplicarla, que es en un txt para que al introducir un nº de factura desde el formulario revise en la columna y si ya fue introducida me avise con un mensaje.
Gracias y espero tu respuesta
Saludos
Ernesto
Disculpa la demora, si me hubieses explicado esto al inicio ya hubiese estado resuelta.
Necesitas una rutina totalmente distinta para esto:
Private Sub Textbox1_AfterUpdate()
'indicar dónde se realizará la búsqueda
filalibre = Sheets("tu_Hoja").Range("A8").End(xlDown).Offset(1, 0).Row 'la variable filalibre guarda el nro. de la primer celda vacía.
dato = textbox1
'rango donde se buscará
rango = "A8:A" & filalibre
If dato <> "" Then
On Error GoTo sigo
Set midato = ActiveSheet.Range(rango).Find(dato, LookIn:=xlValues, LookAt:=xlWhole)
If Not (midato) Is Nothing Then
'si midato no está vacía envía mensaje
Msgbox "El nro ya existe"
End If
Set midato = Nothing
sigo:
End If
End Sub
Esto controlará lo que ingreses en el Textbox1 (ajustar referencias)
Saludos. Probala y comentame si necesita algún otro ajuste.
Elsa
** Más macros Excel en mi sitio, ahora renovado:
http://es.geocities.com/lacibelesdepunilla/index
Necesitas una rutina totalmente distinta para esto:
Private Sub Textbox1_AfterUpdate()
'indicar dónde se realizará la búsqueda
filalibre = Sheets("tu_Hoja").Range("A8").End(xlDown).Offset(1, 0).Row 'la variable filalibre guarda el nro. de la primer celda vacía.
dato = textbox1
'rango donde se buscará
rango = "A8:A" & filalibre
If dato <> "" Then
On Error GoTo sigo
Set midato = ActiveSheet.Range(rango).Find(dato, LookIn:=xlValues, LookAt:=xlWhole)
If Not (midato) Is Nothing Then
'si midato no está vacía envía mensaje
Msgbox "El nro ya existe"
End If
Set midato = Nothing
sigo:
End If
End Sub
Esto controlará lo que ingreses en el Textbox1 (ajustar referencias)
Saludos. Probala y comentame si necesita algún otro ajuste.
Elsa
** Más macros Excel en mi sitio, ahora renovado:
http://es.geocities.com/lacibelesdepunilla/index
