¿Cómo filtrar un listbox mediante uno o varios criterios utilizado textbox?
Solicito su valiosa colaboración en lo siguiente:
Necesito una macro que sea ágil y veloz para poder filtrar un listbox que contiene más de 30 columnas y más de 30 mil filas., para el filtrado se requiere el uso de varias cajas de texto con el fin de ingresar uno o más criterios de búsqueda.
1 Respuesta
Necesito una macro que sea ágil y veloz
Para ayudarte con la macro es preciso que indiques toda la información que sea posible de tu userform y la hoja de excel.
Desde cómo se llama la hoja, hasta cómo se llaman los textbox, cuál columna de la hoja corresponde a cuál textbox, qué columnas vas a cargar en el textbox, tipos de datos, etc, etc,
Si ya tienes un userform, podrías compartir tu archivo en googledrive. Reemplaza la información confidencial por datos genéricos.
Me explicas cómo quieres el funcionamiento del filtrado y te ayudo con todo el código.
¡Gracias!
Buenas tardes, le envío el archivo con los detalles solicitados, el formulario contiene el código para cargar los datos de la hoja al listbox, así como los textbox con las referencias de las columnas a filtrar, no obstante, usted puede modificar el contenido con toda libertad. Gracias nuevamente.
https://drive.google.com/file/d/1F5w6wK-ieLL3Frsx7i6QA171pU-lrLmB/view?usp=sharing
Lo siguiente carga más de 10 columnas y es lo más rápido que conozco, de acuerdo a los criterios de búsqueda.
Option Explicit
Dim a As Variant
Dim sh As Worksheet
Sub Busqueda_VariosCriterios()
Dim i As Long, j As Long, k As Long
Dim c As Variant, d As Variant
Dim bError As Boolean
Dim arr As Variant
'
ListBox1.List = sh.Range("AY1:AZ1").Value
ReDim c(1 To UBound(a, 1), 1 To UBound(a, 2))
k = 0
arr = Array(1, 2, 5, 6, 9, 13, 14, 21, 24)
For i = 1 To UBound(a, 1)
bError = False
For j = 0 To UBound(arr)
If IsError(a(i, arr(j))) Then bError = True
Next
If bError = False Then
If UCase(a(i, 1)) Like "*" & UCase(TextBox1.Text) & "*" And _
UCase(a(i, 2)) Like "*" & UCase(TextBox2.Text) & "*" And _
UCase(a(i, 5)) Like "*" & UCase(TextBox3.Text) & "*" And _
UCase(a(i, 6)) Like "*" & UCase(TextBox4.Text) & "*" And _
UCase(a(i, 9)) Like "*" & UCase(TextBox5.Text) & "*" And _
UCase(a(i, 13)) Like "*" & UCase(TextBox6.Text) & "*" And _
UCase(a(i, 14)) Like "*" & UCase(TextBox7.Text) & "*" And _
UCase(a(i, 21)) Like "*" & UCase(TextBox8.Text) & "*" And _
UCase(a(i, 24)) Like "*" & UCase(TextBox9.Text) & "*" Then
k = k + 1
For j = 1 To UBound(a, 2)
c(k, j) = a(i, j)
Next
End If
End If
Next
'
If k > 0 Then
ReDim d(1 To k, 1 To UBound(a, 2))
For i = 1 To k
For j = 1 To UBound(a, 2)
d(i, j) = c(i, j)
Next
Next
ListBox1.List = d
End If
End Sub
Private Sub TextBox1_Change()
Call Busqueda_VariosCriterios
End Sub
Private Sub TextBox2_Change()
Call Busqueda_VariosCriterios
End Sub
Private Sub TextBox3_Change()
Call Busqueda_VariosCriterios
End Sub
Private Sub TextBox4_Change()
Call Busqueda_VariosCriterios
End Sub
Private Sub TextBox5_Change()
Call Busqueda_VariosCriterios
End Sub
Private Sub TextBox6_Change()
Call Busqueda_VariosCriterios
End Sub
Private Sub TextBox7_Change()
Call Busqueda_VariosCriterios
End Sub
Private Sub TextBox8_Change()
Call Busqueda_VariosCriterios
End Sub
Private Sub TextBox9_Change()
Call Busqueda_VariosCriterios
End Sub
'
Private Sub UserForm_Initialize()
Dim lr As Long
Set sh = Sheets("RESUMEN")
lr = sh.UsedRange.Rows(sh.UsedRange.Rows.Count).Row
a = sh.Range("A1", sh.Cells(lr, _
sh.Cells(1, Columns.Count).End(1).Column)).Value
With ListBox1
.ColumnCount = UBound(a, 2)
.List = a
End With
End SubTe anexo el archivo para que lo pruebes.
https://drive.google.com/file/d/1SNvME6j6TqPG99Dw3CjYtgQt42X5W6qV/view?usp=sharing
