Combobox dependedientes en excel vba
Tengo un pequeño problema y quisiera que me ayudaran por favor:
Tengo una hoja6 con datos, en la columna B tengo varios nombres, algunos se repiten por deudas, y en la columna D con montos de sus deudas. Lo que deseo es que el primer combobox1, me busque un nombre de la columna D (sin repeticiones) y en el combobox2 aparezcan los monto con deuda de ese nombre. Es decir, si una persona tiene 3 deudas, esos monto deben aparecer en Combobox2.
1 Respuesta
Primero que nada necesitas un formulario como este
Y después necesitas copiar el siguiente código en el modulo del formulario, no importa cuantos clientes tengas o si añades o quitas la macro se adapta a los cambios.
Private Sub ComboBox1_Change()
Set CLIENTES = Range("CLIENTES")
CLIENTE = ComboBox1.Value
FILA = WorksheetFunction.Match(CLIENTE, CLIENTES.Columns(2), 0)
CUENTA = WorksheetFunction.CountIf(CLIENTES.Columns(2), CLIENTE)
With ListBox1
.ColumnCount = 4
.RowSource = "=" & CLIENTES.Rows(FILA).Resize(CUENTA, CLIENTES.Columns.Count).Address
End With
End Sub
Private Sub UserForm_Activate()
With UserForm1
.Caption = "MODULO DE CONSULTA DE DEUDAS"
.Move 200, 15
End With
End Sub
Private Sub UserForm_Initialize()
Dim UNICOS As New Collection
Set DATOS = Range("A2").CurrentRegion
With DATOS
FILAS = .Rows.Count
Set DATOS = .Rows(3).Resize(.Rows.Count - 2)
.Select
.Sort KEY1:=Range(.Columns(2).Address), ORDER1:=xlAscending, _
KEY2:=.Range(.Columns(1).Address), ORDER1:=xlAscending, Header:=xlYes
For I = 1 To FILAS - 2
CLIENTE = .Cells(I, 2)
On Error Resume Next
UNICOS.Add CLIENTE, CStr(CLIENTE)
If Err.Number = 0 Then ComboBox1.AddItem CLIENTE
On Error GoTo 0
Next I
.Name = "CLIENTES"
End With
End Sub
Muchas gracias por tu ayuda James, pero la macro me bota un error:
"No se encontró el método o el dato miembro" y me marca esta línea, se pone de azul lo marcado en negrita.
FILA = WorksheetFunction.Match(CLIENTE, Clientes.Columns(2), 0)
Eso pasa porque cuando tecleas directamente en el combobox de inmediato hace la búsqueda y como no encuentra lo que vas tecleando marca error, cambia el código private sub combobox1_change por este, ya no debe de aparecer el error.
Private Sub ComboBox1_Change()
Set CLIENTES = Range("CLIENTES")
CLIENTE = ComboBox1.Value
On Error Resume Next
FILA = WorksheetFunction.Match(CLIENTE, CLIENTES.Columns(2), 0)
On Error GoTo 0
cuenta = WorksheetFunction.CountIf(CLIENTES.Columns(2), CLIENTE)
If cuenta > 0 Then
With ListBox1
.ColumnCount = 4
.RowSource = "=" & CLIENTES.Rows(FILA).Resize(cuenta, CLIENTES.Columns.Count).Address
End With
Else
ListBox1.RowSource = Empty
End If
End Sub
