PROGRAMAR EN VBA MACROS PARA EXCEL: Llenar listbox dependiendo de otro listbox y combobox con vba para excel

Llenar listbox dependiendo de otro listbox y combobox con vba para excel




En un post anterior se expuso un ejemplo de marcro sobre como llenar un listbox dependiendo del dato seleccionado en  un combobox, aquí presento esta macro de Excel o procedimiento de VBA para Excel desarrollado íntegramente Visual Basic para Aplicaciones, también en este ejemplo se hace depender los datos encontrados del valor que es previamente ingresado en combobox, la variante es que no sólo depende de un combobox, sino que depende de otro listbox, el ejemplo muestra como llenar un listbox dependiendo de otro listbox y combobox; resumiendo los datos que muestra  el listbox1, van a depender del valor seleccionado en el combobox y luego de los datos seleccionados en el listbox2. 
La macro VBA excel corre  al apretar el  botón que llama al formulario, en el formulario existen, un  combobox, dos listbox y botón de opciones, que nos permiten definir el orden  que le quisiéramos dar a los datos encontrados, es decir ascendente o descendente.
Al elegir un dato en el combobox, que se dota de datos al cargarse el formulario, se realiza una búsqueda de datos que luego son cargados en el listbox correspondiente; si se hace doble click en algún dato de los desplegados en el listbox, se procede  a realizar otra búsqueda de datos que son cargados en el listbox destinado a ello.
Los botones de opciones se ponen para que si se desea se pueda ordenar en forma  ascendente o descendente, según como se prefiera, dichas opciones se han puesto en cada uno de los listbox que se presenta en el ejemplo.
  
Te recomiendo que leas un excelente libro sobre Excel el que te ayudará manejar las planillas de cálculo, debes hacer click acá, si quieres un libro sobre Excel, en inglés, entonces debes hacer click acá.

El código que se encuentra a continuación se debe ingresar en un  userform, descargando el ejemplo lo podrás ver en funcionamiento, analizar, modificar y adaptar a lo que tú estés realizando el código está abierto sin ningún tipo de restricción.
Podrás ver como funciona al descargar, desde el link del final, el ejemplo de la macro, lo cual facilita mucho su comprensión, si bien se trata de hacer los ejemplos lo más fácil posible, algún conocimiento en VBA se debería tener para poder modificar las macros y adaptarla para de este modo automatizar tu libro excel.


Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'Evito movimientos de la pantalla
Application.ScreenUpdating = False
Dim fila, a, colum1 As Integer
On Error Resume Next
'Borra datos del listbox
ListBox1.Clear
a = 0
fila = 2
'Selecciono columna donde buscar
d = Combobox1
Select Case d
Case "Departamento"
colum1 = 5
Case "Nacionalidad"
colum1 = 2
Case "Estado"
colum1 = 3
End Select
'Bucle mientras la fila no esté vacia
While Sheets("hoja1").Cells(fila, colum1) <> Empty
      d = ListBox2.Value
'Si el dato de la fila coincide con textbox carga los datos al listbox
 
   If Sheets("hoja1").Cells(fila, colum1) = d Then

        'Copia los datos de la celda list box
        a = ListBox1.ListCount
        ListBox1.AddItem
        ListBox1.List(a, 0) = Sheets("hoja1").Cells(fila, 1)
        ListBox1.List(a, 1) = Sheets("hoja1").Cells(fila, 2)
        ListBox1.List(a, 2) = Sheets("hoja1").Cells(fila, 3)
        ListBox1.List(a, 3) = Sheets("hoja1").Cells(fila, 4)
        ListBox1.List(a, 4) = Sheets("hoja1").Cells(fila, 5)
   End If
  
'Aumento la fila para que pase a la siguiente
fila = fila + 1
Wend
'Mostrar el número de entradas en el ListBox1.
UserForm1.Label8.Caption = "Total Registros: " & a + 1


'Devuelvo movimientos de la pantalla
Application.ScreenUpdating = True
End Sub

Private Sub Combobox1_Change()
'Evito movimientos de la pantalla
Application.ScreenUpdating = False
Dim fila2, colum2, b, uf As Integer
Dim col As String
'Dim ran As Range
Dim DSR As New Collection
On Error Resume Next
'Borra datos del listbox
ListBox2.Clear
b = 0
fila2 = 2
'Selecciono columna donde buscar
dato = Combobox1
Select Case dato
Case "Departamento"
colum2 = 5
Case "Nacionalidad"
colum2 = 2
Case "Estado"
colum2 = 3
End Select
Select Case colum2
Case 5
col = "E"
Case 2
col = "B"
Case 3
col = "C"
End Select
'Determina rango de datos a cargar al listbox
uf = Sheets("hoja1").Range("A" & Rows.Count).End(xlUp).Row
ran = col & fila2 & ":" & col & uf
For Each Celda In Range(ran)
DSR.Add Celda.Value, CStr(Celda.Value)
Next Celda
'Agregar elementos a la lista
For Each Item In DSR
UserForm1.ListBox2.AddItem Item
Next Item
'Mostrar el número de entradas en el ListBox1.
UserForm1.Label7.Caption = "Total Registros: " & DSR.Count

'Devuelvo movimientos de la pantalla
Application.ScreenUpdating = True
End Sub
Private Sub OptionButton1_Click()
'Evito movimientos de la pantalla
Application.ScreenUpdating = False
Dim r1, r2, r3 As String
'determines last row with data
uf = Sheets("hoja1").Range("A" & Rows.Count).End(xlUp).Row
'will help determine ranges to sort data
r1 = "b2" & ":b" & uf
r3 = "A1" & ":E" & uf
'sorts the data
 ActiveWorkbook.Worksheets("hoja1").Sort.SortFields.Clear
 ActiveWorkbook.Worksheets("hoja1").Sort.SortFields.Add Key:=Range(r1) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
 With ActiveWorkbook.Worksheets("hoja1").Sort
        .SetRange Range(r3)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
 End With

'Luego de ordenar corre macro para llenar listbox
Combobox1_Change
'Devuelvo movimientos de la pantalla
Application.ScreenUpdating = True
End Sub
Private Sub OptionButton2_Click()
'Evito movimientos de la pantalla
Application.ScreenUpdating = False
Dim r1, r2, r3 As String
'determines last row with data
uf = Sheets("hoja1").Range("A" & Rows.Count).End(xlUp).Row
'will help determine ranges to sort data
r1 = "b2" & ":b" & uf
'Se usa para filtrar por otro criterio
'r2 = "B2" & ":B" & uf
r3 = "A1" & ":E" & uf
'sorts the data
 ActiveWorkbook.Worksheets("hoja1").Sort.SortFields.Clear
 ActiveWorkbook.Worksheets("hoja1").Sort.SortFields.Add Key:=Range(r1) _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal

 'Segundo criterio de filtrado
 'ActiveWorkbook.Worksheets("hoja1").Sort.SortFields.Add Key:=Range(r2) _
       ' , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal

 With ActiveWorkbook.Worksheets("hoja1").Sort
        .SetRange Range(r3)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
 End With

'Luego de ordenar corre macro para llenar listbox
Combobox1_Change
'Devuelvo movimientos de la pantalla
Application.ScreenUpdating = True
End Sub
Private Sub OptionButton3_Click()
'Evito movimientos de la pantalla
Application.ScreenUpdating = False
Dim r1, r2, r3 As String
'determines last row with data
uf = Sheets("hoja1").Range("A" & Rows.Count).End(xlUp).Row
'will help determine ranges to sort data
r1 = "A2" & ":A" & uf
r2 = "E2" & ":E" & uf
r3 = "A1" & ":E" & uf
'sorts the data
 ActiveWorkbook.Worksheets("hoja1").Sort.SortFields.Clear
 ActiveWorkbook.Worksheets("hoja1").Sort.SortFields.Add Key:=Range(r1) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

 'Segundo criterio de filtrado
 ActiveWorkbook.Worksheets("hoja1").Sort.SortFields.Add Key:=Range(r2) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

 With ActiveWorkbook.Worksheets("hoja1").Sort
        .SetRange Range(r3)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
 End With

'Carga datos ordenados al listbox
Dim fila, a, colum1 As Integer
On Error Resume Next
'Borra datos del l istbox
ListBox1.Clear
a = 0
fila = 2
'Selecciono columna donde buscar
d = Combobox1
Select Case d
Case "Departamento"
colum1 = 5
Case "Nacionalidad"
colum1 = 2
Case "Estado"
colum1 = 3
End Select
'Bucle mientras la fila no esté vacia
While Sheets("hoja1").Cells(fila, colum1) <> Empty
      d = ListBox2.Value
'Si el dato de la fila coincide con textbox carga los datos al listbox
   If Sheets("hoja1").Cells(fila, colum1) = d Then

        'Copia los datos de la celda list box
        a = ListBox1.ListCount
        ListBox1.AddItem
        ListBox1.List(a, 0) = Sheets("hoja1").Cells(fila, 1)
        ListBox1.List(a, 1) = Sheets("hoja1").Cells(fila, 2)
        ListBox1.List(a, 2) = Sheets("hoja1").Cells(fila, 3)
        ListBox1.List(a, 3) = Sheets("hoja1").Cells(fila, 4)
        ListBox1.List(a, 4) = Sheets("hoja1").Cells(fila, 5)
   End If
  
'Aumento la fila para que pase a la siguiente
fila = fila + 1
Wend
'Devuelvo movimientos de la pantalla
Application.ScreenUpdating = True
End Sub
Private Sub OptionButton4_Click()
'Evito movimientos de la pantalla
Application.ScreenUpdating = False
Dim r1, r2, r3 As String
'determines last row with data
uf = Sheets("hoja1").Range("A" & Rows.Count).End(xlUp).Row
'will help determine ranges to sort data
r1 = "A2" & ":A" & uf
r2 = "E2" & ":E" & uf
r3 = "A1" & ":E" & uf
'sorts the data
 ActiveWorkbook.Worksheets("hoja1").Sort.SortFields.Clear
 ActiveWorkbook.Worksheets("hoja1").Sort.SortFields.Add Key:=Range(r1) _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal

 'Segundo criterio de filtrado
 ActiveWorkbook.Worksheets("hoja1").Sort.SortFields.Add Key:=Range(r2) _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal

 With ActiveWorkbook.Worksheets("hoja1").Sort
        .SetRange Range(r3)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
 End With

'Carga datos ordenados al listbox
Dim fila, a, colum1 As Integer
On Error Resume Next
'Borra datos del l istbox
ListBox1.Clear
a = 0
fila = 2
'Selecciono columna donde buscar
d = Combobox1
Select Case d
Case "Departamento"
colum1 = 5
Case "Nacionalidad"
colum1 = 2
Case "Estado"
colum1 = 3
End Select
'Bucle mientras la fila no esté vacia
While Sheets("hoja1").Cells(fila, colum1) <> Empty
      d = ListBox2.Value
'Si el dato de la fila coincide con textbox carga los datos al listbox
   If Sheets("hoja1").Cells(fila, colum1) = d Then

        'Copia los datos de la celda list box
        a = ListBox1.ListCount
        ListBox1.AddItem
        ListBox1.List(a, 0) = Sheets("hoja1").Cells(fila, 1)
        ListBox1.List(a, 1) = Sheets("hoja1").Cells(fila, 2)
        ListBox1.List(a, 2) = Sheets("hoja1").Cells(fila, 3)
        ListBox1.List(a, 3) = Sheets("hoja1").Cells(fila, 4)
        ListBox1.List(a, 4) = Sheets("hoja1").Cells(fila, 5)
   End If
  
'Aumento la fila para que pase a la siguiente
fila = fila + 1
Wend
End Sub
Private Sub UserForm_Initialize()
Label2.Caption = Sheets("hoja1").Cells(1, 1)
Label3.Caption = Sheets("hoja1").Cells(1, 2)
Label4.Caption = Sheets("hoja1").Cells(1, 3)
Label5.Caption = Sheets("hoja1").Cells(1, 4)
Label6.Caption = Sheets("hoja1").Cells(1, 5)
Label7.Caption = Clear
Label8.Caption = Clear
Combobox1.AddItem ("Departamento")
Combobox1.AddItem ("Nacionalidad")
Combobox1.AddItem ("Estado")

End Sub
     

Código que  se debe ingresar en un módulo

Sub form()
UserForm1.Show
End Sub



Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.




If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.


Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends