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.

3

3 Respuestas

25.175 pts. Nunca es tarde para aprender....

¿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

4.703.150 pts. Sancho, si los perros ladran ...

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
.
209.200 pts. Si de mis mayores gustos, mis disgustos han nacido,...

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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas