Excel : Filtrado de Celdas TextBox - VBA
Tengo una hoja de excel con data desde la fila 5, columna C hasta la fila 2000, columna Z.
He creado un TextBox y dentro había colocado este código :
Private Sub TextoFiltrar_Change()
CriterioFiltro = "*" & Sheets("Data").TextoFiltrar.Text & "*"
Range("C4").AutoFilter Field:=1, Criteria1:=CriterioFiltro
End Sub
Este código me filtra la hoja con el texto que escriba en el TextBox, osea busca la coincidencias y solo me visualiza esas filas.
El problema está en que solo puedo hacer la referencia a una columna para la búsqueda pero me gustaría que al momento de filtrar pueda establecer más columnas de búsqueda pero no se como modificar el código indicado líneas arriba.
En el video Nº 36 de mi canal traté el tema de Filtro Dinámico con VBA.
Desde el blog podrás descargar el libro con los ejemplos. También incluye los ejemplos del video Nº 35: Filtros Avanzados.
El que te servirá de guía para tu caso, es el de la Hoja1. Si bien se trata de un formulario, el evento que dispara la búsqueda es el Change de un TextBox.
https://elsamatilde.blogspot.com/2020/08/filtros-avanzados-con-vba.html
Cualquier duda, contactame nuevamente enviando todas las aclaraciones, en lo posible con imagen de encabezados de fila y columnas de datos.
Estimada Elsa, muchas gracias por la información y disculpa la demora en la respuesta.
Revise el video 36 y el video 35, lo que busco tiene mayor similitud con el video 35 pero yo necesito utilizar una sola celda para ingresar el texto a filtrar.
Te adjunto una imagen :
En la celda D2 tengo un TextBox donde ingreso el texto que se debe filtrar buscando las coincidencias en el rango de celdas de C5:N1000
Muchas gracias
Probá con esta macro. Se ejecuta al salir de TextBox.
Una vez que encuentra una coincidencia en una columna ya no sigue filtrando.
Ajustá el nro de col a 24 si va a ser Z .
Private Sub TextBox1_LostFocus() If TextBox1 = "" Then ActiveSheet.ShowAllData: Exit Sub CriterioFiltro = "*" & Sheets("Data").TextBox1.Text & "*" For i = 1 To 12 'col desde C hasta N Range("C4").AutoFilter Field:=i, Criteria1:=CriterioFiltro 'se evalúa si hubo resultados filtrados canti = Range("C" & Rows.Count).End(xlUp).Row If canti > 4 Then Exit For Else ActiveSheet.ShowAllData End If Next i End Sub
Sdos!
Hola Elsa, buenas noches.
Probé con el código que me enviaste pero no me funciono, buscando información del Range pude modificar mi código de la siguiente forma :
Private Sub TextoFiltrar_Change()
' Field:=1 -> Es la primera columna empezando desde la columna C4
Dim rango As Range
Set rango = Range("C4:E2000")
CriterioFiltro = "*" & Sheets("Data").TextoFiltrar.Text & "*"
rango.AutoFilter Field1:=1, Criteria1:=CriterioFiltro, Operator:=xlOr, Field2:=3, Criteria2:=CriterioFiltro
End Sub
Es como lo quisiera, escribir un texto y filtrar ese texto en la columna 1 "C" y la columna 3 "E". Según la imagen que subí más arriba.
El problema es que me esta apareciendo un error que adjunto la imagen :
Y no se el motivo.
Muchas gracias por la ayuda.
Leonel.
Todas mis macros van probadas y funcionando con el ejemplo que les dejo.
Si no funciona debes volver a comentar o enviar mayores aclaraciones. Es posible que no se interprete correctamente o el modelo deja dudas.
Ahora recree en parte tu imagen y lo que hace la macro es:
1- Buscar en col C... si lo encuentra ese es el resultado que mostrará.
2- Si no lo encuentra en C buscará en E... mostrando ese resultado.
Private Sub TextoFiltrar_Change() 'si el control se muestra vacío, quita el filtrado If TextoFiltrar = "" Then ActiveSheet.ShowAllData: Exit Sub Dim rango As Range Set rango = Range("C4:E2000") CriterioFiltro = "*" & Sheets("Data").TextoFiltrar.Text & "*" For i = 1 To 3 Step 2 'col desde C o E Range("C4").AutoFilter Field:=i, Criteria1:=CriterioFiltro 'se evalúa si hubo resultados filtrados canti = Range("C" & Rows.Count).End(xlUp).Row If canti > 4 Then Exit For 'si lo encontró finaliza la búsqueda Else ActiveSheet.ShowAllData 'quita el filtrado para repetir con la col 3 End If Next i End Sub
Y como verás en la imagen, así fueron los resultados.
ATENCIÓN: no está buscando la coincidencia en las 2 col, sino en cualquiera de las 2.
Por favor si puedes revisarla sin tanta demora. Sino luego debieras enviarme tu hoja para que no pierda tiempo en volver a armar un modelo, ya que elimino todos los libros de ejemplo ;)
Sdos!
Hola Elsa, buenas tardes.
Puse el código que me enviaste y ahora si me está filtrando, envío captura de pantalla :
Pero no me está filtrando todo, asumo no hace diferencia escribir entre mayúsculas y minúsculas.
Lo que está en amarillo es lo que no me ha filtrado
El texto se debería buscar en la columna "C" y la columna "E", si hay coincidencia en cualquiera de esas columnas debería mostrarse el resultado.
Gracias,
Leonel.
Cierto, porque al filtrar en 1 columna, el resto de las filas se ocultan ... y allí se podrían encontrar filas en col E con el mismo criterio. La macro anterior estaba pensada por si no encontraba datos en C que los busque en E.
Te paso otra macro entonces para obtener resultados como los de la imagen siguiente:
Private Sub TextoFiltrar_LostFocus() 'si el control se muestra vacío, quita el filtrado If TextoFiltrar = "" Then ActiveSheet.ShowAllData: Exit Sub Dim rango As Range Set rango = Range("C5:E2000") CriterioFiltro = "*" & Sheets("Data").TextoFiltrar.Text & "*" For i = 1 To 3 Step 2 'col desde C o E Range("C4").AutoFilter Field:=i, Criteria1:=CriterioFiltro 'se evalúa si hubo resultados filtrados canti = Range("C" & Rows.Count).End(xlUp).Row If canti > 4 Then 'copia el rango filtrado en otro destino x = Range("J" & Rows.Count).End(xlUp).Row + 1 rango.SpecialCells(xlCellTypeVisible).Copy Destination:=Range("J" & x) GoTo sigo 'si lo encontró finaliza la búsqueda Else ActiveSheet.ShowAllData 'quita el filtrado para repetir con la col 3 End If sigo: ActiveSheet.ShowAllData Next i End Sub
Otra opción podría ser utilizar Filtro Avanzado. Pero necesitarás un rango auxiliar para colocar allí los criterios. En mi ejemplo quedaron en L1:M3, cambia estas referencias según tu hoja, y el nombre de tu control (aquí es TextBox1)
Private Sub TextBox1_LostFocus() 'con filtro avanzado If TextBox1 = "" Then If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData Exit Sub End If Dim rango As Range Set rango = Range("C4:E2000") CriterioFiltro = "*" & Sheets("Data").TextBox1.Text & "*" 'coloca los criterios en las 2 celdas. [L2] = CriterioFiltro [M3] = CriterioFiltro rango.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _ Range("L1:M3"), Unique:=False End Sub
En ambos ejemplos el evento es LostFocus.
Sdos!
Hola Elsa, buenas noches.
Borre el código que aparecía en el evento "Change" y lo copie en el evento "LostFocus" y solo me filtra lo siguiente :
pero me aparece este error :
Slds,
Leonel.
Es que los códigos deben ser adaptados al modelo de hoja.
En mi caso el rango es:
Set rango = Range("C5:E2000")
Y el rango copiado lo coloqué en col J:
'copia el rango filtrado en otro destino x = Range("J" & Rows.Count).End(xlUp).Row + 1
Y en el 2do ejemplo, con Filtro Avanzado, el rango de criterios lo coloqué en L1:M3
rango.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _ Range("L1:M3"), Unique:=False
Si no tenemos las hojas de Uds, solo podemos dejar un código con un rango de ejemplo. Y probado y funcionando para ese ejemplo. Que te lo puedo enviar (si me dejas un correo o te paso el mío) .
Pero, no me comentaste que lo tuyo era una tabla. Por lo tanto lo mejor sería que me envíes tu hoja con los títulos y 1 o 2 filas solamente para que pueda obtener el rango y nombre de tu tabla. Así te ajusto la macro allí mismo.
Mis correos aparecen en la sección Contactos de mi sitio. Aquí generalmente el Editor me lo cambia ... pero intentemos:
Cibersoft. Arg ARROBA gmail PUNTO com (el nombre va en minúsc)
Sdos.
Si, recibí el primer correo anunciando que el viernes enviarías tu libro y te respondí quedando a la espera.
Con respecto al libro NO lo recibí. SI es muy pesado, es posible que Gmail no te permita el envío.
En ese caso hacé una copia y ahí quitale todas las hojas innecesarias dejando solo una cantidad razonable de filas como para probarlo.
Sdos!
- Compartir respuesta