Doble o triple filtrado de datos sobre un listbox
Tengo este formulario donde tengo varias formas de filtrar los datos en el listbox, por cada combobox un botón de filtro que funciona bajo el siguiente código
Private Sub CommandButton5_Click()
Application.ScreenUpdating = False
On Error goto Errores
If cmbMomento.Value = "" Then Exit Sub
Worksheets("Recetas").Select
Me.ListBox1.Clear
j = 1
For i = 4 To 1000
If Cells(i, j).Value = cmbMomento.Value Then
'If LCase(Cells(i, j).Value) Like “ * ” & LCase(Me.TxtFiltro4.Value) & “ * ” Then
Me.ListBox1.AddItem Cells(i, j)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Cells(i, j).Offset(0, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = Cells(i, j).Offset(0, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = Cells(i, j).Offset(0, 3)
Else
End If
Next i
Exit Sub
Errores:
MsgBox "No se encuentra en la base de datos", vbExclamation, "¡ATENCIÓN!"
Application.ScreenUpdating = True
End SubQuiero, por un lado, colocar únicamente un botón de filtrado en vez de tener 4 botones y que dicho botón funcione para cualquiera de los item que estén en los combobox, así si solo hay un item en combo1 filtra sólo por ese ítem, si hay 2 ítem en combo1 y combo 2, filtrará según los dos en el listbox.
1 respuesta
H o l a : No necesitas ningún botón, se puede realizar el filtro se utilizas los eventos change de los combobox. Te anexo el código:
Private Sub cmbMomento_Change()
Call filtrar
End Sub
Private Sub cmbTipo_Change()
Call filtrar
End Sub
Private Sub cmbEspecialidad_Change()
Call filtrar
End Sub
Private Sub cmbReceta_Change()
Call filtrar
End Sub
'
Sub filtrar()
'Por.Dante Amor
Set h1 = Worksheets("Recetas")
ListBox1.Clear
j = 1
For i = 4 To h1.Range("A" & Rows.Count).End(xlUp).Row
If cmbMomento = "" Then txt1 = h1.Cells(i, "A") Else txt1 = cmbMomento
If cmbTipo = "" Then txt2 = h1.Cells(i, "B") Else txt2 = cmbTipo
If cmbEspecialidad = "" Then txt3 = h1.Cells(i, "C") Else txt3 = cmbEspecialidad
If cmbReceta = "" Then txt4 = h1.Cells(i, "D") Else txt4 = cmbReceta
'
If h1.Cells(i, "A").Value = txt1 And _
h1.Cells(i, "B").Value = txt2 And _
h1.Cells(i, "C").Value = txt3 And _
h1.Cells(i, "D").Value = txt4 Then
ListBox1.AddItem h1.Cells(i, "A").Value
ListBox1.List(ListBox1.ListCount - 1, 1) = h1.Cells(i, "B").Value
ListBox1.List(ListBox1.ListCount - 1, 2) = h1.Cells(i, "C").Value
ListBox1.List(ListBox1.ListCount - 1, 3) = h1.Cells(i, "D").Value
End If
Next i
End SubCada vez que cambies el dato en cualquier combo, se ejecuta la rutina "Filtrar", entonces se revisa la hoja "Recetas" y todas las filas, las coincidencias son cargadas al list.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
¡Gracias!
Increíble el código y la funcionalidad. Lo de usar el evento change lo había pensado pero usando textbox y al tener ya dicha base me parecía más factible, pero desde luego es mucha mejor opción y va estupendo. Me podría volver loco tratando de hacer yo tal código.
Lo único, un detalle, es que la "receta" me gustaría, si es posible, que saliera de un textbox en lugar de combo ya que no tengo lista de la receta, sería muy grande, pero estaría bien que al empezar a escribir la receta en el text saltase el filtro (igual que pasa con los combos tal cual está). Yo he probado a usar RecetaBox y me.RecetaBox.value sustituyendo donde has puesto cmbReceta pero no filtra nada, ¿como puedo hacer?
Mil gracias genio
Cambié el cmbReceta por TextReceta
Agregué la sentencia Like para buscar el texto que introduces en la columna
Private Sub cmbMomento_Change()
Call filtrar
End Sub
Private Sub cmbTipo_Change()
Call filtrar
End Sub
Private Sub cmbEspecialidad_Change()
Call filtrar
End Sub
Private Sub TextReceta_Change()
Call filtrar
End Sub
'
Sub filtrar()
'Por.Dante Amor
Set h1 = Worksheets("Recetas")
ListBox1.Clear
j = 1
For i = 4 To h1.Range("A" & Rows.Count).End(xlUp).Row
If cmbMomento = "" Then txt1 = h1.Cells(i, "A") Else txt1 = cmbMomento
If cmbTipo = "" Then txt2 = h1.Cells(i, "B") Else txt2 = cmbTipo
If cmbEspecialidad = "" Then txt3 = h1.Cells(i, "C") Else txt3 = cmbEspecialidad
If TextReceta = "" Then txt4 = h1.Cells(i, "D") Else txt4 = TextReceta
'
If h1.Cells(i, "A").Value = txt1 And _
h1.Cells(i, "B").Value = txt2 And _
h1.Cells(i, "C").Value = txt3 And _
h1.Cells(i, "D").Value Like "*" & txt4 & "*" Then
ListBox1.AddItem h1.Cells(i, "A").Value
ListBox1.List(ListBox1.ListCount - 1, 1) = h1.Cells(i, "B").Value
ListBox1.List(ListBox1.ListCount - 1, 2) = h1.Cells(i, "C").Value
ListBox1.List(ListBox1.ListCount - 1, 3) = h1.Cells(i, "D").Value
End If
Next i
End Subsal u dos
