Filtrar listbox mediante dos combobox y un textbox

Question

el 5 dic. 18

Filtrar listbox mediante dos combobox y un textbox

En una empresa textil se lleva a cabo el registro del historial de repuestos usados en tre bobinadoras Quisiera saber como puedo filtrar los datos contenidos en un listbox con varias columnas utilizando los criterios de distintos combobox y un textbox. Quisiera que al utilizar uno estos objetos, dos o los tres juntos me filtre los valores que necesito en mi listbox. Lo mismo que se realiza con los segmentadores que usamos para filtrar tablas en hojas de Excel pero en mi caso uso un formulario Ejemplo:

El combobox1 tiene 3 criterios B1, B2 y B3, indica la bobinadora

El combobox2 tiene 2 criterios A y B, indica el lado de cada bobinadora

El textbox el numero máximo que se puede colocar 126, que indica la cantidad de bobinas máximas

Gracias de antemano a quien me pueda ayudar.

1 Respuesta

James Bond, Si de mis mayores gustos, mis disgustos han nacido, gustos al... · Accepted Answer · 2018-12-05T17:06:16.0000000Z

Respuesta de James Bond

1

Este es el resultado de la macro, solo me queda la duda de como cargas los combobox y el listbox, esto es importante ya que en ocasiones se genera un conflicto entre las tres diferentes formas de cargarlo que origina un error bloqueando y deteniendo la macro, si estas usando combobox1. RowSource habria que modificar la macro

te paso la macro

Private Sub ComboBox1_Change()
Set datos = Range("datos")
Set destino = Range("destino")
bobinado = ComboBox1.Value
rango = Range("a1").CurrentRegion.Address
ActiveSheet.Range(rango).AutoFilter Field:=1, Criteria1:=bobinado
destino.CurrentRegion.Clear
datos.SpecialCells(xlCellTypeVisible).Copy: destino.PasteSpecial
matriz = destino.CurrentRegion
With ListBox1
    .Clear
    .List = matriz
End With
End Sub
Private Sub ComboBox2_Change()
Set datos = Range("datos")
Set destino = Range("destino")
lado = ComboBox2.Value
rango = Range("a1").CurrentRegion.Address
ActiveSheet.Range(rango).AutoFilter Field:=2, Criteria1:=lado
destino.CurrentRegion.Clear
datos.SpecialCells(xlCellTypeVisible).Copy: destino.PasteSpecial
matriz = destino.CurrentRegion
With ListBox1
    .Clear
    .List = matriz
End With
End Sub
Private Sub ListBox1_Click()
End Sub
Private Sub TextBox1_AfterUpdate()
Set datos = Range("datos")
Set destino = Range("destino")
bobina = TextBox1.Text
rango = Range("a1").CurrentRegion.Address
ActiveSheet.Range(rango).AutoFilter Field:=3, Criteria1:=bobina
destino.CurrentRegion.Clear
datos.SpecialCells(xlCellTypeVisible).Copy: destino.PasteSpecial
matriz = destino.CurrentRegion
With ListBox1
    .Clear
    .List = matriz
End With
End Sub
Private Sub TextBox1_Change()
End Sub
Private Sub UserForm_Initialize()
Set datos = Range("a1").CurrentRegion
With datos
    .AutoFilter
    matriz = datos
        With ListBox1
            .List = matriz
            .ColumnCount = datos.Columns.Count
        End With
       'ComboBox1.AddItem "b3"
       'ComboBox2.AddItem "b"
    .Name = "datos"
    Set tabla = .Rows(.Rows.Count + 3).Resize(1, 1)
    tabla.Name = "destino"
End With
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Range("destino").CurrentRegion.Clear
End Sub

el 5 dic. 18

Muchas gracias por responder James.

Bueno cargue el combobox y el listbox de la manera más sencilla que conozco pues no soy un experto en esto y aun sigo aprendiendo, te muestro:

Private Sub UserForm_Initialize()
ufila As Integer
Dim p As Worksheet
Application.ScreenUpdating = False
On Error Resume Next
Me.COMB_BOBINADORA.AddItem "B1"
Me.COMB_BOBINADORA.AddItem "B2"
Me.COMB_BOBINADORA.AddItem "B3"
Me.COMB_LADO.AddItem "A"
Me.COMB_LADO.AddItem "B"
Me.MULTIPAGE_GENERAL.Value = 0
Sheets("INFORMACION").Select
Set p = Sheets("INFORMACION")
ufila = p.Range("A" & Rows.Count).End(xlUp).Row
With Me.LIST_BUSCAR
    .ColumnCount = 9
    .ColumnWidths = "60 pt;40 pt;40 pt;50 pt;80 pt;100 pt;80 pt;50 pt;50 pt;"
    .RowSource = "INFORMACION!B3:I" & ufila
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

PD. Voy a probar el código y analizarlo cualquier duda te escribo y enormemente agradecido por tu ayuda.

el 6 dic. 18

James Saludos...

Estuve probando el código lo adapte a mi archivo y funciono lo único es que cuando realizas el filtro de una bobinadora, un lado o una bobina a la que no hay datos en la tabla respectiva enseguida arroja un error y se detiene la macro.

También note que al momento de filtrar la cabecera del listbox desaparece y no se ve muy estético que digamos. Son detalles que realmente no se como reparar

Gracias de antemano en la solución que me puedas dar.

el 7 dic. 18

Cambie las instrucciones de cargado por matriz los encabezados no hay manera de cargalos así que ahora los carga usando la propiedad rowsource, este esta programado para ser dinámico sin importar si quitas o agregues la macro cargara lo que queda, esta imagen es es resaltado de la macro ya arreglada

y esta es la macro

Private Sub ComboBox1_Change()
Set datos = Range("datos")
Set destino = Range("destino")
bobinado = ComboBox1.Value
rango = Range("a1").CurrentRegion.Address
ActiveSheet.Range(rango).AutoFilter Field:=1, Criteria1:=bobinado
destino.CurrentRegion.Clear
datos.SpecialCells(xlCellTypeVisible).Copy: destino.PasteSpecial
Set destino = destino.CurrentRegion
With destino
    f = .Rows.Count: c = .Columns.Count
    If f > 1 And c > 1 Then
        Set destino = .Rows(2).Resize(f - 1, c)
    Else
        Set destino = .Rows(2).Resize(f, c)
    End If
End With
With ListBox1
    .RowSource = Empty
    .ColumnHeads = True
    .RowSource = destino.Address
End With
Set datos = Nothing: Set destino = Nothing
End Sub
Private Sub ComboBox2_Change()
Set datos = Range("datos")
Set destino = Range("destino")
lado = ComboBox2.Value
rango = Range("a1").CurrentRegion.Address
ActiveSheet.Range(rango).AutoFilter Field:=2, Criteria1:=lado
destino.CurrentRegion.Clear
datos.SpecialCells(xlCellTypeVisible).Copy: destino.PasteSpecial
Set destino = destino.CurrentRegion
With destino
    f = .Rows.Count: c = .Columns.Count
    If f > 1 And c > 1 Then
        Set destino = .Rows(2).Resize(f - 1, c)
    Else
        Set destino = .Rows(2).Resize(f, c)
    End If
End With
With ListBox1
    .RowSource = Empty
    .RowSource = destino.Address
    .ColumnHeads = True
End With
Set datos = Nothing: Set destino = Nothing
End Sub
Private Sub ListBox1_Click()
End Sub
Private Sub TextBox1_AfterUpdate()
Set datos = Range("datos")
Set destino = Range("destino")
bobina = TextBox1.Text
rango = Range("a1").CurrentRegion.Address
ActiveSheet.Range(rango).AutoFilter Field:=3, Criteria1:=bobina
destino.CurrentRegion.Clear
datos.SpecialCells(xlCellTypeVisible).Copy: destino.PasteSpecial
Set destino = destino.CurrentRegion
With destino
    f = .Rows.Count: c = .Columns.Count
    If f > 1 And c > 1 Then
        Set destino = .Rows(2).Resize(f - 1, c)
    Else
        Set destino = .Rows(2).Resize(f, c)
    End If
End With
With ListBox1
.RowSource = Empty
    .RowSource = destino.Address
    .ColumnHeads = True
End With
Set datos = Nothing: Set destino = Nothing
End Sub
Private Sub TextBox1_Change()
End Sub
Private Sub UserForm_Initialize()
Set datos = Range("a1").CurrentRegion
With datos
    .Name = "datos"
    Set datos = .Rows(2).Resize(.Rows.Count - 1, .Columns.Count)
    .AutoFilter
    matriz = datos
        With ListBox1
            .RowSource = datos.Address
            .ColumnCount = datos.Columns.Count
            .ColumnHeads = True
        End With
       ComboBox1.AddItem "b3"
       ComboBox1.AddItem "b4"
       ComboBox1.AddItem "b5"
       ComboBox2.AddItem "b"
    Set tabla = .Rows(.Rows.Count + 3).Resize(1, 1)
    tabla.Name = "destino"
Set tabla = Nothing: Set datos = Nothing
End With
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Range("destino").CurrentRegion.Clear
End Sub

el 7 dic. 18

¡Gracias! enhorabuena James... agradecido por tu ayuda

Bendiciones...

PD. Cualquier duda te escribo

el 12 dic. 18

Saludos Jame...

Te escribo porque no se que sucede no me realiza el filtro como tal, lo único que hice fue adaptarlo a mi proyecto cambiando los nombres. Me puedes ayudar?

el 25 dic. 18

Sin dar más detalles ¿cómo te puedo ayudar?, ¿Qué nombres cambiaste?

el 28 dic. 18

Saludos James.

Bueno el detalle que tengo es que el listbox que se filtra tiene mas de 10 columnas, por lo que solo se puede usar la propiedad rowsource. Ahora bien yo tengo los datos almacenados en una hoja de nombre "Registros" los cuales cargo en el listbox a iniciarse el formulario de la siguiente manera:

Private Sub UserForm_Initialize()
Dim ufila As Integer, uf As Integer, FILA As Integer
Dim r As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
MultiPage1.Value = 0
Set r = Sheets("Registro")
uf = r.Range("A" & Rows.Count).End(xlUp).Row
With Me.LIST_BUSCAR
    .ColumnCount = 13
    .ColumnWidths = "50 pt;70 pt;70 pt;70 pt; 70 pt;40 pt;40 pt;40 pt;75 pt;70 pt;50 pt;50 pt;140 pt"
    .RowSource = "registro!A2:M" & uf
End With
Range("tabla3").Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Luego obtengo lo siguiente sin problema:

El código que me pasaste hace referencia a una región actual, lo que quisiera que fuera la hoja "Registros" específicamente. Te sugiero que se pueda crear una hoja nueva donde se inserte una tabla con los datos filtrados y ahí si cargarlos por la propiedad rowsource que dará sin problemas la estética idónea entonces cada vez que se filtre, borrar los datos de la tabla y anexar los nuevos filtrados.

Yo lo único que no se es plantear el condicional para poder filtrar bien sea en el textbox y en los combobox.

Te paso un código que estoy usando en este mismo proyecto que explica lo que te menciono mas falta el condicional.

Private Sub Boton_guardar_Click()
On Error Resume Next
Application.ScreenUpdating = False
'Valida fecha para el text box
'*********Validaciones***************
ubica1 = Mid(TEXT_FECHA.Text, 3, 1)
ubica2 = Mid(TEXT_FECHA.Text, 6, 1)
'comparamos si se trata de '/'
If ubica1 <> "/" Or ubica2 <> "/" Then
MsgBox ("Debes ingresar datos con este formato: dd/mm/aa")
TEXT_FECHA.SetFocus
Exit Sub
End If
dia = Mid(TEXT_FECHA.Value, 1, 2)
mes = Mid(TEXT_FECHA.Value, 4, 2)
año = Mid(TEXT_FECHA.Value, 7, 4)
fecha = Len(TEXT_FECHA)
'Controla lo ingresado, si no se cumple no es fecha y sale en msgbox
If dia > 31 Or mes > 12 Or año < 1900 Or fecha > 10 Then
MsgBox "Fecha incorrecta"
TEXT_FECHA.SetFocus
Exit Sub
End If
Set f = Sheets("filtro")
f.Select
uf = f.ListObjects("tabla3").ListRows.Count
'***Validaciones de campos vacios****************
If TEXT_FECHA = Empty Then
    MsgBox ("Ingrese la fecha"), vbCritical, "Advertencia"
    TEXT_FECHA.SetFocus
ElseIf COMB_M1 = Empty Then
    MsgBox ("Ingrese el nombre del mecanico 1"), vbCritical, "Advertencia"
    COMB_M1.SetFocus
ElseIf COMB_SUPERVISOR = Empty Then
    MsgBox ("Ingresa el nombre del supervisor"), vbCritical, "Advertencia"
    COMB_SUPERVISOR.SetFocus
ElseIf COMB_JEFE = Empty Then
    MsgBox ("Ingresa el nombre del jefe de mantenimiento"), vbCritical, "Advertencia"
    COMB_JEFE.SetFocus
ElseIf COMB_JEFE = Empty Then
    MsgBox ("Ingresa el nombre del jefe de mantenimiento"), vbCritical, "Advertencia"
    COMB_JEFE.SetFocus
ElseIf COMB_STAREX = Empty Then
    MsgBox ("Ingresa el numero de la extrusora correspondiente"), vbCritical, "Advertencia"
    COMB_STAREX.SetFocus
ElseIf COMB_LADO = Empty Then
    MsgBox ("Ingresa el lado de la bobina correspondiente"), vbCritical, "Advertencia"
    COMB_LADO.SetFocus
    ElseIf TEXT_NUMERO = Empty Then
    MsgBox ("Ingresa el numero de la bobinadora correspondiente"), vbCritical, "Advertencia"
    TEXT_NUMERO.SetFocus
ElseIf COMB_FALLA = Empty Then
    MsgBox ("Ingresa el tipo de falla presentada"), vbCritical, "Advertencia"
    COMB_FALLA.SetFocus
ElseIf COMB_PROCEDIMIENTO = Empty Then
    MsgBox ("Ingresa el procedimiento aplicado en la bobinadora"), vbCritical, "Advertencia"
    COMB_PROCEDIMIENTO.SetFocus
Else
'***Carga de registro en la base de datos**************************
    f.ListObjects("tabla3").ListColumns(1).Range(uf + 2) = CDate(TEXT_FECHA)
    f.ListObjects("tabla3").ListColumns(2).Range(uf + 2) = COMB_M1
    f.ListObjects("tabla3").ListColumns(3).Range(uf + 2) = COMB_M2
    f.ListObjects("tabla3").ListColumns(4).Range(uf + 2) = COMB_SUPERVISOR
    f.ListObjects("tabla3").ListColumns(5).Range(uf + 2) = COMB_JEFE
    f.ListObjects("tabla3").ListColumns(6).Range(uf + 2) = Val(COMB_STAREX.Value)
    f.ListObjects("tabla3").ListColumns(7).Range(uf + 2) = COMB_LADO
    f.ListObjects("tabla3").ListColumns(8).Range(uf + 2) = Val(TEXT_NUMERO)
    f.ListObjects("tabla3").ListColumns(9).Range(uf + 2) = COMB_FALLA
    f.ListObjects("tabla3").ListColumns(10).Range(uf + 2) = COMB_PROCEDIMIENTO
    f.ListObjects("tabla3").ListColumns(11).Range(uf + 2) = Val(TEXT_CANTIDAD.Value)
    f.ListObjects("tabla3").ListColumns(12).Range(uf + 2) = TEXT_CODIGO
    f.ListObjects("tabla3").ListColumns(13).Range(uf + 2) = TEXT_PARTE
    COMB_STAREX = Empty
    COMB_LADO = Empty
    TEXT_NUMERO = Empty
    COMB_FALLA = Empty
    COMB_PROCEDIMIENTO = Empty
    TEXT_CANTIDAD = Empty
    TEXT_CODIGO = Empty
    TEXT_PARTE = Empty
End If
ufila = f.ListObjects("tabla3").ListRows.Count
With Me.LIST_CARGAR
    .ColumnCount = 13
    .ColumnWidths = "0 pt;0 pt;0 pt;0 pt;0 pt;40 pt;40 pt;50 pt;75 pt;70 pt;50 pt;50 pt;140 pt"
    .RowSource = "filtro!A2:M" & ufila + 1
End With
'limpia
COMB_STAREX = clear
COMB_LADO = clear
TEXT_NUMERO = clear
COMB_PROCEDIMIENTO = clear
COMB_FALLA = clear
TEXT_CANTIDAD = clear
TEXT_CODIGO = clear
TEXT_PARTE = clear
COMB_STAREX.SetFocus
End Sub

Aqui simplemente capto los datos, los guardo en una hoja temporal, luego los cargo en el listbox (13 columnas) para luego ya almacenarlos en la hoja Registros.

el 1 ene. 19

Prueba con este código crea una hoja temporal "TEMP" donde copia la información filtrada y de ahí la pasa al listbox, le hice modificaciones a la macro para que lea los datos de la hoja "REGISTROS" solamente, así como algunas modificaciones para que los filtrados sean más rápidos como recliclar el código de copiado para que sea el mismo para las 3 condiciones en vez de hacer un código de copiado por cada condición, la macro crea y borra la hoja "TEMP" así que no tienes que crearla.

Private Sub ComboBox1_Change()
Set DATOS = Range("datos")
Set HR = Worksheets("REGISTROS")
Set ht = Worksheets("TEMP")
Set destino = ht.Range("A2")
c = DATOS.Columns.Count
bobinado = ComboBox1.Value
rango = Range("a2").CurrentRegion.Address
HR.Range(rango).AutoFilter Field:=1, Criteria1:=bobinado
destino.CurrentRegion.Clear
With DATOS
    .SpecialCells(xlCellTypeVisible).Copy: destino.PasteSpecial
    .Rows(0).Copy: ht.Range("A1").Resize(1, c).PasteSpecial
    ht.Range("A1").CurrentRegion.Name = "DESTINO"
End With
    CARGAR_DATOS
    Set DATOS = Nothing: Set HR = Nothing
End Sub
Private Sub ComboBox2_Change()
Set DATOS = Range("datos")
Set HR = Worksheets("REGISTROS")
Set ht = Worksheets("TEMP")
Set destino = ht.Range("A2")
c = DATOS.Columns.Count
LADO = ComboBox2.Value
rango = Range("a2").CurrentRegion.Address
HR.Range(rango).AutoFilter Field:=2, Criteria1:=LADO
destino.CurrentRegion.Clear
With DATOS
    .SpecialCells(xlCellTypeVisible).Copy: destino.PasteSpecial
    .Rows(0).Copy: ht.Range("A1").Resize(1, c).PasteSpecial
    ht.Range("A1").CurrentRegion.Name = "DESTINO"
End With
    CARGAR_DATOS
    Set DATOS = Nothing: Set HR = Nothing
End Sub
Private Sub TextBox1_AfterUpdate()
Set DATOS = Range("datos")
Set HR = Worksheets("REGISTROS")
Set ht = Worksheets("TEMP")
Set destino = ht.Range("A2")
c = DATOS.Columns.Count
bobina = TextBox1.Text
rango = Range("a2").CurrentRegion.Address
HR.Range(rango).AutoFilter Field:=3, Criteria1:=bobina
destino.CurrentRegion.Clear
With DATOS
    .SpecialCells(xlCellTypeVisible).Copy: destino.PasteSpecial
    .Rows(0).Copy: ht.Range("A1").Resize(1, c).PasteSpecial
    ht.Range("A1").CurrentRegion.Name = "DESTINO"
End With
    CARGAR_DATOS
    Set DATOS = Nothing: Set HR = Nothing
End Sub
Private Sub UserForm_Initialize()
Set HR = Worksheets("REGISTROS")
Set DATOS = HR.Range("A1").CurrentRegion
With DATOS
    .AutoFilter
    f = .Rows.Count: c = .Columns.Count
    .Sort _
    KEY1:=HR.Range(.Columns(1).Address), ORDER1:=xlAscending, _
    KEY2:=HR.Range(.Columns(2).Address), ORDER2:=xlAscending, _
    KEY3:=HR.Range(.Columns(1).Address), ORDER1:=xlAscending, _
    Header:=xlYes
    Set DATOS = .Rows(2).Resize(f, c)
    With ListBox1
        .RowSource = "REGISTROS!" & DATOS.Address
        .ColumnCount = c
        .ColumnHeads = True
    End With
On Error Resume Next
Sheets("TEMP").Select
If Err.Number > 0 Then
    Sheets.Add
    ActiveSheet.Name = "TEMP"
End If
On Error GoTo 0
For I = 1 To 2
    .Columns(I).Copy: Range("A1").PasteSpecial xlPasteAll
    Range("A1").RemoveDuplicates Columns:=1
    matriz = Range("A1").CurrentRegion
    If I = 1 Then ComboBox1.List = matriz
    If I > 1 Then ComboBox2.List = matriz
    Erase matriz
    Range("A:a").Clear
Next I
DATOS.Name = "DATOS"
End With
Set DATOS = Nothing: Set HR = Nothing
End Sub
Sub CARGAR_DATOS()
    Set ht = Worksheets("temp")
    Set destino = ht.Range("A1").CurrentRegion
    With destino
        f = .Rows.Count: c = .Columns.Count
        On Error Resume Next
        Set destino = .Rows(2).Resize(f - 1, c)
        If Err.Number > 0 Then MsgBox ("no hay informacion"), vbInformation, "AVISO"
        On Error GoTo 0
    End With
    With ListBox1
        .RowSource = ""
        .RowSource = "TEMP!" & destino.Address
        .ColumnHeads = True
    End With
    Set destino = Nothing: set ht=nothing
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
With Application
    .DisplayAlerts = False
        Sheets("temp").Delete
    .DisplayAlerts = True
End With
End Sub

el 4 ene. 19

¡Gracias! James...

Si mas o menos entiendo lo que hiciste aunque hay algunas líneas de código que no interpreto muy bien pues aun no he llegado a ese nivel de programación, pero si en términos generales creaste una función CARGAR_DATOS para resumir la codificación y solo llamas a la misma cuando se necesite, me imagino que coloco esa función en un modulo? También noto que debo cambiar la manera de inicializar el formulario y no como lo tenia para que no cause errores. Cualquier duda te escribo.

Nuevamente gracias por tener el tiempo y la dedicación de atender a mi pregunta, mis respetos.

Bendiciones!!!!

el 4 ene. 19

Cargar_datos no esta en un modulo lo coloque dentro del mismo formulario esta hasta el final de las líneas de programación, si lo coloco en un modulo tendría que usar más código para manejar la información, le agregue un programa para que si quieres añadir más embobinados y lados, no modifiques nada del programa sino que los escribas directamente en la tabla la macro cargara los datos en ambos combos eliminando los repetidos sin usar bucles todo esto lo va a hacer en la tabla temp que como dije no necesitas crearla la amcro la crea por ti y cuando cierres el formulario la misma macro borra la hoja para no hacer el archivo pesado.

el 4 ene. 19

Filtrar listbox mediante dos combobox y un textbox

1 Respuesta

Añade tu respuesta

Más respuestas relacionadas

Detectar cambios en tabla dinámica

Macro con combinación de teclas

Pasar datos de listbox a hoja con decimales

Una macro que de aviso sobre vencimiento de una cedula de identidad

Error decimales en hoja de excel

Filtrar información y luego pasar a otro libro

Código VBA para ocultar formulario

Recorrer una tabla de Access

Diferentes Formato de Fecha en Hoja de Calculo

Como insertar de forma separada registros en diferentes columnas en una misma fila

¿Cuál es el mejor programa de compresión para ficheros de gran tamaño?

¿Qué anchura y resolución de pantalla son adecuadas para ver TV a 2 metros?

¿Me pueden espiar el WhatsApp?

¿Cómo recuperar archivos de un smartphone "roto"?