Posición de celdas con un texto
Tenía esta macro desarrollada para que me informe la posición de las celdas en las que contiene un texto buscado:
Sub buscar_cosas()
On Error Resume Next
Application.ScreenUpdating = False
Range("J:K").Clear 'Esto debería ser variable... (sólo sirve para limpiar anteriores búsquedas)
donde_estamos = ActiveCell.Address
'--------------------------------------
'Datos esenciales:
celda_inicial = "A1"
celda_final = "J100"
valor_buscado = InputBox("Introduce el valor, dato, o texto que deseas buscar:", "Dato a buscar")
mostrar_datos = "K1"
If Trim(valor_buscado) = "" Then Exit Sub
'--------------------------------------
'pasamos los datos a variables
min_fila = Range(celda_inicial).Row
max_fila = Range(celda_final).Row
min_columna = Range(celda_inicial).Column
max_columna = Range(celda_final).Column
'nos situamos en la primera celda
Range(celda_inicial).Select
'comenzamos a buscar el dato
For i = min_fila To max_fila
For j = min_columna To max_columna
If InStr(ActiveCell.Value, valor_buscado) > 0 Then
'ponemos el dato en color rojo
'Selection.Font.ColorIndex = 3
'guardamos la referencia donde se encuentra el dato
celdas_datos = celdas_datos & "," & ActiveCell.Address
End If
ActiveCell.Offset(0, 1).Select
Next
ActiveCell.Offset(1, -max_columna).Select
Next
'AHORA MOSTRAREMOS LO ENCONTRADO:
'--------------------------------------------------------------------------------
'quitamos la coma inicial del array de referencias
celdas_datos = Mid(celdas_datos, 2, Len(celdas_datos))
'ahora reemplazamos la referencia absoluta
celdas_datos = Replace(celdas_datos, "$", "")
'mostramos las referencias de las celdas
Range(mostrar_datos) = "Los datos encontrados están en: " & celdas_datos & ", es decir, aquí:"
'bajamos una fila
nuevos_datos = Range(mostrar_datos).Offset(1, 0).Address
Range(nuevos_datos).Select
'descomponemos el array
celdas = Split(celdas_datos, ",")
For i = 0 To UBound(celdas)
'ponemos la celda en cuestión
ActiveCell = celdas(i)
ActiveCell.Offset(1, 0).Select
Next
'--------------------------------------------------------------------------------
'Ordenamos el rango de datos con las referencias
Range(nuevos_datos).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range(nuevos_datos), Order1:=xlAscending
'nos situamos en la celda donde estábamos
Range(mostrar_datos).Offset(0, -1).FormulaR1C1 = valor_buscado
Range(mostrar_datos).Offset(1, -1).FormulaR1C1 = "=COUNTBLANK(R[-1]C[1]:R[48]C[1])"
If Range(mostrar_datos).Offset(1, -1).Value = 49 Then
MsgBox "No hay resultados en su búsqueda"
Range(mostrar_datos).FormulaR1C1 = "No se encontró nada"
End If
'Seleccionar donde estábamos inicialmente
Range(mostrar_datos).Offset(1, -1).ClearContents
Range(donde_estamos).Select
Application.ScreenUpdating = True
End Sub
Prácticamente está copiada de una página web. El error que he encontrado aquí es que no me busca bien en el rango especificado (por ejemplo en b20) y no entiendo por qué. Lo bueno de esta macro es que me dice todas aquellas celdas donde contiene ese texto buscado, y no sólo la primera que analice.
Sub buscar_cosas()
On Error Resume Next
Application.ScreenUpdating = False
Range("J:K").Clear 'Esto debería ser variable... (sólo sirve para limpiar anteriores búsquedas)
donde_estamos = ActiveCell.Address
'--------------------------------------
'Datos esenciales:
celda_inicial = "A1"
celda_final = "J100"
valor_buscado = InputBox("Introduce el valor, dato, o texto que deseas buscar:", "Dato a buscar")
mostrar_datos = "K1"
If Trim(valor_buscado) = "" Then Exit Sub
'--------------------------------------
'pasamos los datos a variables
min_fila = Range(celda_inicial).Row
max_fila = Range(celda_final).Row
min_columna = Range(celda_inicial).Column
max_columna = Range(celda_final).Column
'nos situamos en la primera celda
Range(celda_inicial).Select
'comenzamos a buscar el dato
For i = min_fila To max_fila
For j = min_columna To max_columna
If InStr(ActiveCell.Value, valor_buscado) > 0 Then
'ponemos el dato en color rojo
'Selection.Font.ColorIndex = 3
'guardamos la referencia donde se encuentra el dato
celdas_datos = celdas_datos & "," & ActiveCell.Address
End If
ActiveCell.Offset(0, 1).Select
Next
ActiveCell.Offset(1, -max_columna).Select
Next
'AHORA MOSTRAREMOS LO ENCONTRADO:
'--------------------------------------------------------------------------------
'quitamos la coma inicial del array de referencias
celdas_datos = Mid(celdas_datos, 2, Len(celdas_datos))
'ahora reemplazamos la referencia absoluta
celdas_datos = Replace(celdas_datos, "$", "")
'mostramos las referencias de las celdas
Range(mostrar_datos) = "Los datos encontrados están en: " & celdas_datos & ", es decir, aquí:"
'bajamos una fila
nuevos_datos = Range(mostrar_datos).Offset(1, 0).Address
Range(nuevos_datos).Select
'descomponemos el array
celdas = Split(celdas_datos, ",")
For i = 0 To UBound(celdas)
'ponemos la celda en cuestión
ActiveCell = celdas(i)
ActiveCell.Offset(1, 0).Select
Next
'--------------------------------------------------------------------------------
'Ordenamos el rango de datos con las referencias
Range(nuevos_datos).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range(nuevos_datos), Order1:=xlAscending
'nos situamos en la celda donde estábamos
Range(mostrar_datos).Offset(0, -1).FormulaR1C1 = valor_buscado
Range(mostrar_datos).Offset(1, -1).FormulaR1C1 = "=COUNTBLANK(R[-1]C[1]:R[48]C[1])"
If Range(mostrar_datos).Offset(1, -1).Value = 49 Then
MsgBox "No hay resultados en su búsqueda"
Range(mostrar_datos).FormulaR1C1 = "No se encontró nada"
End If
'Seleccionar donde estábamos inicialmente
Range(mostrar_datos).Offset(1, -1).ClearContents
Range(donde_estamos).Select
Application.ScreenUpdating = True
End Sub
Prácticamente está copiada de una página web. El error que he encontrado aquí es que no me busca bien en el rango especificado (por ejemplo en b20) y no entiendo por qué. Lo bueno de esta macro es que me dice todas aquellas celdas donde contiene ese texto buscado, y no sólo la primera que analice.
1 Respuesta
Respuesta de silvianu
1
Haa ok, bueno lo que pasa es que tu no me habías especificado que necesitabas varios valores, es decir que necesitabas que encontrara y de mostrara el valor de la celda correspondiente en más de 1 ocasión, esta función está bien hecha pero es un tanto complicada.
Este ejemplo que te pongo aquí lo que hace es que crea una hoja nueva, toma el nombre y en esta nueva hoja va insertando las celdas en donde se encuentra el valor buscado.
Creo que esta es un poco más sencilla y la puedes ir adaptando como mejor te convenza.
'******inicia aqui**********
Sub macro_busqueda()
'
Dim hoja As String
Dim palabra As String
Dim celda As String
Dim x As Integer
'
x = 1
Sheets.Add After:=Sheets(Sheets.Count)
hoja = ActiveSheet.Name
'nombre de la hoja en donde se buscará
Sheets("Hoja3").Select
Range("A1").Activate
'este hace referencia al valor que está en la celda A1 (ejemplo aquí puedes poner lo que estés buscando)
palabra = Range("A1").Value
Do
Sheets("Hoja3").Select
'busca la palabra
Cells.Find(What:=palabra, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
'obtiene la celda en la que encontró dicha palabra
celda = ActiveCell.Address
Sheets(hoja).Select
' aqui pregunta si la celda es igual a la celda insertada en la primer celda de la nueva hoja, es decir si el valor de celda es igual al que está en "A1" (la primer celda en donde buscó y encontro el valor a buscar), al igual le puse la condicion que si celda es igual a A1 no la inserte, ya que como está tomando el valor a buscar de esa celda, sería repetitivo (esa condicion la puedes omitir, ya que en este ejemplo toma el valor de esa celda pero en tu caso no se de donde estas tomando el valor a buscar)
If celda = Range("A1").Value And x > 1 Or celda = "$A$1" Then
Exit Do
' si cumple las condiciones significa que ya no hay más valores en celdas diferentes (ya encontró todos los valores) y termina el ciclo
End If
Cells(x, "A") = celda
x = x + 1
Cells.FindNext
Loop While x > 1 ' esta condicion es solo para que continue la busqueda ya que no se sabe con cuantos valores repetidos cuenta la hoja
' para que quede seleccionada la hoja que se insertó y así puedas ver los valores de las celdas en donde está repetido el valor
Sheets(hoja).Select
End Sub
'************Termina aquí***************
'
Cualquier comentario estoy al pendiente
Este ejemplo que te pongo aquí lo que hace es que crea una hoja nueva, toma el nombre y en esta nueva hoja va insertando las celdas en donde se encuentra el valor buscado.
Creo que esta es un poco más sencilla y la puedes ir adaptando como mejor te convenza.
'******inicia aqui**********
Sub macro_busqueda()
'
Dim hoja As String
Dim palabra As String
Dim celda As String
Dim x As Integer
'
x = 1
Sheets.Add After:=Sheets(Sheets.Count)
hoja = ActiveSheet.Name
'nombre de la hoja en donde se buscará
Sheets("Hoja3").Select
Range("A1").Activate
'este hace referencia al valor que está en la celda A1 (ejemplo aquí puedes poner lo que estés buscando)
palabra = Range("A1").Value
Do
Sheets("Hoja3").Select
'busca la palabra
Cells.Find(What:=palabra, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
'obtiene la celda en la que encontró dicha palabra
celda = ActiveCell.Address
Sheets(hoja).Select
' aqui pregunta si la celda es igual a la celda insertada en la primer celda de la nueva hoja, es decir si el valor de celda es igual al que está en "A1" (la primer celda en donde buscó y encontro el valor a buscar), al igual le puse la condicion que si celda es igual a A1 no la inserte, ya que como está tomando el valor a buscar de esa celda, sería repetitivo (esa condicion la puedes omitir, ya que en este ejemplo toma el valor de esa celda pero en tu caso no se de donde estas tomando el valor a buscar)
If celda = Range("A1").Value And x > 1 Or celda = "$A$1" Then
Exit Do
' si cumple las condiciones significa que ya no hay más valores en celdas diferentes (ya encontró todos los valores) y termina el ciclo
End If
Cells(x, "A") = celda
x = x + 1
Cells.FindNext
Loop While x > 1 ' esta condicion es solo para que continue la busqueda ya que no se sabe con cuantos valores repetidos cuenta la hoja
' para que quede seleccionada la hoja que se insertó y así puedas ver los valores de las celdas en donde está repetido el valor
Sheets(hoja).Select
End Sub
'************Termina aquí***************
'
Cualquier comentario estoy al pendiente
A esta macro no le puedo poner ninguna pega. Funciona perfectamente tal y como quiero. La otra macro (que indicaba la primera coincidencia encontrada) también me gustó y por eso te puse 5 estrellas, y a esta macro me gustaría ponerle 6. Muchas gracias por tu tiempo y por tu excelente solución. Un saludo!
