ComboBoxs dependientes codigo VBA Excel?
Deseo trabajar con 4 comboboxs dependientes dentro de Excel, OJO: los ComboBoxs Artículos, Marca y Objeto deben tener las mismas características de búsqueda como el 1er ComboBox (Empresa).
Las búsquedas de datos deben ser en forma horizontal.
Gracias por su gran aporte al conocimiento desinteresadamente.
Adjunto Excel: Archivo
3 Respuestas
Respuesta de Adriel Ortiz Mangia
1
[Hola
Te paso la macro del generoso Dante Amor
Cambia toda la macro por esto
Valora la respuesta para finalizar
'se actualiza el textbox al clickear en el checkbox
Private Sub CheckBox1_Click()
If CheckBox1 Then
TextBox1.Text = "ALMACEN EXTERNO"
Else
TextBox1.Text = "ALMACEN"
End If
End Sub
Private Sub ComboBox1_Change()
'Fuente Dante
ComboBox2.Clear
If ComboBox1.ListIndex = -1 Or ComboBox1.Value = "" Then Exit Sub
'
Set h1 = Sheets("Hoja1")
For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
If h1.Cells(i, "A") = ComboBox1.Value Then
ComboBox2.AddItem h1.Cells(i, "B")
End If
Next
End Sub
'EVENTO AL PRESIONAR F1
Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If Not CheckBox1 Then 'SI NO ESTA ACTIVO EL CHECKBOX
If KeyCode = vbKeyF1 Then 'si se presiona F1
UserForm2.Show
End If
End If
End Sub
'PARA NO ESCRIBIR EN LOS COMBOBOX
Private Sub ComboBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Not CheckBox1 Then 'SI NO ESTA ACTIVO EL CHECKBOX
KeyAscii = 0
End If
End Sub
Private Sub ComboBox2_Change()
'Fuente Dante
ComboBox3.Clear
If ComboBox1.ListIndex = -1 Or ComboBox1.Value = "" Then Exit Sub
'
Set h1 = Sheets("Hoja1")
For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
If h1.Cells(i, "A") = ComboBox1.Value Then
ComboBox3.AddItem h1.Cells(i, "C")
End If
Next
End Sub
Private Sub ComboBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Not CheckBox1 Then
KeyAscii = 0
End If
End Sub
Private Sub ComboBox3_Change()
'Fuente Dante
ComboBox4.Clear
If ComboBox1.ListIndex = -1 Or ComboBox1.Value = "" Then Exit Sub
'
Set h1 = Sheets("Hoja1")
For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
If h1.Cells(i, "A") = ComboBox1.Value Then
ComboBox4.AddItem h1.Cells(i, "D")
End If
Next
End Sub
Private Sub UserForm_Initialize()
' ComboBox1.RowSource = "FRUTAS" 'Rango donde estan contenido los datos
' ComboBox1.ControlTipText = "Presiona F1 para abrir la lista"
'
' TextBox1.Enabled = False
' CheckBox1_Click
End Sub
'BOTON DE SALIR
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub UserForm_Activate()
'Fuente Dante
'Carga el combo1
Set h1 = Sheets("Hoja1")
For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
agregar ComboBox1, Cells(i, "A").Value
Next
End Sub
Sub agregar(combo As ComboBox, dato As String)
'Fuente Dante
For i = 0 To combo.ListCount - 1
Select Case StrComp(combo.List(i), dato, vbTextCompare)
Case 0: Exit Sub 'ya existe en el combo y ya no lo agrega
Case 1: combo.AddItem dato, i: Exit Sub 'Es menor, lo agrega antes del comparado
End Select
Next
combo.AddItem dato 'Es mayor lo agrega al final
End Sub
Respuesta de James Bond
1
Te paso un ejemplo adaptado a tu informacion, solo copia el codigo y pegalo a tu formulario
'se actualiza el textbox al clickear en el checkbox
Private Sub CheckBox1_Click()
If CheckBox1 Then
TextBox1.Text = "ALMACEN EXTERNO"
Else
TextBox1.Text = "ALMACEN"
End If
End Sub
Private Sub ComboBox1_Change()
Dim EMPRESAS As Range
Dim UNICOS As New Collection
Dim CUENTA As Integer, I As Integer
Set EMPRESAS = Range("frutas")
empresa = ComboBox1.Value
With EMPRESAS
CUENTA = WorksheetFunction.CountIf(.Columns(1), empresa)
FILA = WorksheetFunction.Match(empresa, .Columns(1), 0)
Set ARTICULOS = .Rows(FILA).Resize(CUENTA)
End With
ComboBox2.Clear
With ARTICULOS
.Name = "ARTICULOS"
For I = 1 To .Rows.Count
ARTICULO = .Cells(I, 2)
On Error Resume Next
UNICOS.Add ARTICULO, CStr(ARTICULO)
If Err.Number = 0 Then ComboBox2.AddItem ARTICULO
On Error GoTo 0
Next I
End With
ComboBox2.ListIndex = 0
Set EMPRESAS = Nothing: Set ARTICULO = Nothing
End Sub
'EVENTO AL PRESIONAR F1
Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If Not CheckBox1 Then 'SI NO ESTA ACTIVO EL CHECKBOX
If KeyCode = vbKeyF1 Then 'si se presiona F1
UserForm2.Show
End If
End If
End Sub
'PARA NO ESCRIBIR EN LOS COMBOBOX
Private Sub ComboBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Not CheckBox1 Then 'SI NO ESTA ACTIVO EL CHECKBOX
KeyAscii = 0
End If
End Sub
Private Sub ComboBox2_Change()
Dim UNICOS As New Collection
Dim ARTICULOS As Range, MARCAS As Range
Dim ARTICULO As String
Dim CUENTA As Integer, FILA As Integer, I As Integer
ARTICULO = ComboBox2.Value
Set ARTICULOS = Range("ARTICULOS")
ComboBox3.Clear
With ARTICULOS
CUENTA = WorksheetFunction.CountIf(.Columns(2), ARTICULO)
If CUENTA > 0 Then
FILA = WorksheetFunction.Match(ARTICULO, .Columns(2), 0)
Set MARCAS = .Rows(FILA).Resize(CUENTA)
MARCAS.Select
MARCAS.Name = "MARCAS"
For I = 1 To CUENTA
MARCA = MARCAS.Cells(I, 3)
On Error Resume Next
UNICOS.Add MARCA, CStr(MARCA)
If Err.Number = 0 Then ComboBox3.AddItem MARCA
On Error GoTo 0
Next I
ComboBox3.ListIndex = 0
End If
Set ARTICULOS = Nothing: Set MARCAS = Nothing
End With
End Sub
Private Sub ComboBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Not CheckBox1 Then
KeyAscii = 0
End If
End Sub
Private Sub ComboBox3_Change()
Set MARCAS = Range("MARCAS")
MARCA = ComboBox3.Value
With MARCAS
CUENTA = WorksheetFunction.CountIf(.Columns(3), MARCA)
If CUENTA > 0 Then
FILA = WorksheetFunction.Match(MARCA, .Columns(3), 0)
ComboBox4.RowSource = .Cells(FILA, 4).Resize(CUENTA).Address
.Cells(FILA, 4).Resize(CUENTA).Select
End If
ComboBox4.ListIndex = 0
End With
End Sub
Private Sub ComboBox4_Change()
End Sub
Private Sub UserForm_Initialize()
Dim UNICOS As New Collection
Dim EMPRESAS As Range
Dim I As Integer
Dim empresa As String
Set EMPRESAS = Range("frutas")
ComboBox1.Clear
With EMPRESAS
.Sort _
key1:=Range(.Columns(1).Address), order1:=xlAscending, _
key2:=Range(.Columns(2).Address), order2:=xlAscending, _
key3:=Range(.Columns(3).Address), order3:=xlAscending, _
Header:=xl
For I = 1 To .Rows.Count
empresa = .Cells(I, 1)
On Error Resume Next
UNICOS.Add empresa, CStr(empresa)
If Err.Number = 0 Then ComboBox1.AddItem empresa
On Error GoTo 0
Next I
ComboBox1.ListIndex = 0
End With
TextBox1.Enabled = False
CheckBox1_Click
Set EMPRESAS = Nothing
End Sub
'BOTON DE SALIR
Private Sub CommandButton1_Click()
Unload Me
End Sub
Respuesta de Programar Excel
Estos ejemplos
https://www.programarexcel.com/2013/06/llenar-listbox-dependiendo-de-otro.html
aca tienes mas sobre combobox
https://www.youtube.com/playlist?list=PLdK9H5dMIfQhfsDkpH5ZCBGrh68DfOTa3
y aca sobre listbox