4 combobox dependientes en un formulario de VBA en EXCEl línea de actividad, causa de línea y actividad, subcausa de causa.
Debo realizar un formulario de daño de equipos que me permita filtrar la información, es decir que si selección la actividad "empaque", me muestre la líneas de producción que la realiza "8"y luego me filtre las causas de acuerdo a la línea y actividad, después de seleccionar la causa me deje seleccionar la subcausa del daño.
¿Podrías explicarte un poco más que es lo que de esas hacer?
Tienes un userform con 4 combobox
¿Uno de ellos tendrá las actividades (una es empaque) y los otros 3?
¿Los combobox los cargaras con Additem o rowsource?
Aguardo tu respuesta
2 respuestas más de otros expertos
Te anexo un código que tiene para 8 combobox dependientes:
Programar 8 Combobox dependientes en un Formulario VBA Excel
Y también te paso un ejemplo con 3 combobox dependientes, para que lo revises y lo ajustes a 4 combos
Formulario en Excel con Varios Combobox Dependientes
'.[Sal u dos. Dante Amor. No olvides votar las otras respuestas y valorar la respuesta. '.[Avísame cualquier duda .
Te paso esta macro la imagen que ves son 4 combox dependientes uno del otro lo único que tienes que hacer para adaptarla a tus datos es cambiar en el modulo activate la línea que contiene "A1" por el valor de la celda donde incian tus datos.
y esta es la macro
Private Sub ComboBox1_Change()
Dim FUNCION As WorksheetFunction
Dim UNICOS As New Collection
Set DATOS = Range("DATOS")
Set FUNCION = WorksheetFunction
ACT = ComboBox1.Value
ComboBox2.Clear
With DATOS
CUENTA = FUNCION.CountIf(.Columns(1), ACT)
If CUENTA > 0 Then
FILA = FUNCION.Match(ACT, .Columns(1), 0)
Set LINEAS = .Rows(FILA).Resize(CUENTA)
For I = 1 To CUENTA
LINEA = LINEAS.Cells(I, 2)
On Error Resume Next
UNICOS.Add LINEA, CStr(LINEA)
If Err.Number = 0 Then ComboBox2.AddItem LINEA
On Error GoTo 0
Next I
End If
End With
LINEAS.Name = "LINEAS"
Set DATOS = Nothing: Set LINEAS = Nothing: Set UNICOS = Nothing
End Sub
Private Sub ComboBox2_Change()
Dim FUNCION As WorksheetFunction
Dim UNICOS As New Collection
Set DATOS = Range("LINEAS")
Set FUNCION = WorksheetFunction
LINEA = ComboBox2.Value
ComboBox3.Clear
With DATOS
CUENTA = FUNCION.CountIf(.Columns(2), LINEA)
If CUENTA > 0 Then
FILA = FUNCION.Match(LINEA, Columns(2), 0)
Set CAUSAS = .Rows(FILA).Resize(CUENTA)
For I = 1 To CUENTA
CAUSA = CAUSAS.Cells(I, 3)
On Error Resume Next
UNICOS.Add CAUSA, CStr(CAUSA)
If Err.Number = 0 Then ComboBox3.AddItem CAUSA
On Error GoTo 0
Next I
CAUSAS.Name = "CAUSAS"
End If
End With
End Sub
Private Sub ComboBox3_Change()
Set CAUSAS = Range("CAUSAS")
CAUSA = ComboBox3.Value
INDICE = ComboBox3.ListIndex + 1
SUBCAUSA = CAUSAS.Cells(INDICE, 4)
ComboBox4.Clear
ComboBox4.AddItem SUBCAUSA
End Sub
Private Sub Label2_Click()
End Sub
Private Sub UserForm_Activate()
Dim UNICOS As New Collection
Set DATOS = Range("A1").CurrentRegion
NOMBRE = ActiveSheet.Name
With ActiveWorkbook.Worksheets(NOMBRE)
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range(DATOS.Columns(1).Address) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range(DATOS.Columns(2).Address) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range(DATOS.Columns(3).Address) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range(DATOS.Columns(4).Address) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange Range(DATOS.Address)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
ComboBox1.Clear
With DATOS
FILAS = .Rows.Count
COLUMNAS = .Columns.Count
For I = 2 To FILAS
ACT = .Cells(I, 1)
On Error Resume Next
UNICOS.Add ACT, CStr(ACT)
If Err.Number = 0 Then ComboBox1.AddItem ACT
On Error GoTo 0
Next I
DATOS.Name = "DATOS"
Set DATOS = Nothing: Set UNICOS = Nothing
End With
End Sub