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
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
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.
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.
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
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?
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.
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
¡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!!!!
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.
- Compartir respuesta