¿Como enlazar Combobox dependientes y unir con Textbox al finalizar filtro?

Soy bastante novato y estoy aprendiendo sobre este lenguaje. Tengo un formulario en cual tengo 6 combobox los cuales están enlazados entre sí, es decir, cuando selecciono algún valor en el primer combobox este condiciona el segundo y así sucesivamente (filtro en cascada) y la idea es que al finalizar me arroje los valores (la celda siguiente) de ese filtro en un textbox (en este caso el promedio).

Mi problema es que cuando realizo los últimos pasos (filtros de años y meses) no me arrojan valores, creo que es por la variable numérica, pero como mencione con anterioridad estoy aprendiendo este lenguaje el cual no manejo, me podría explicar o aconsejar cambios para poder obtener buenos resultados

De antemano muchas gracias

Saludos cordiales

Lo que pretendo hacer y como están ordenados los datos es así:

y esta es la sintaxis 

Private Sub ComboBox5_Change()
ComboBox6.Clear
uf = Sheets("Datos").Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To uf
If Sheets("Datos").Cells(i, "D") = ComboBox4 And _
Sheets("Datos").Cells(i, "E") = ComboBox5 Then
AddItem ComboBox6, Sheets("Datos").Cells(i, "F")
End If
Next
End Sub

Private Sub ComboBox4_Change()
ComboBox5.Clear
uf = Sheets("Datos").Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To uf
If Sheets("Datos").Cells(i, "C") = ComboBox3 And _
Sheets("Datos").Cells(i, "D") = ComboBox4 Then
AddItem ComboBox5, Sheets("Datos").Cells(i, "E")
End If
Next
End Sub
Private Sub ComboBox3_Change()
ComboBox4.Clear
uf = Sheets("Datos").Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To uf
If Sheets("Datos").Cells(i, "B") = ComboBox2 And _
Sheets("Datos").Cells(i, "C") = ComboBox3 Then
AddItem ComboBox4, Sheets("Datos").Cells(i, "D")
End If
Next
End Sub

Private Sub ComboBox2_Change()
ComboBox3.Clear
uf = Sheets("Datos").Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To uf
If Sheets("Datos").Cells(i, "A") = ComboBox1 And _
Sheets("Datos").Cells(i, "B") = ComboBox2 Then
AddItem ComboBox3, Sheets("Datos").Cells(i, "C")
End If
Next

End Sub
Private Sub ComboBox1_Change()
ComboBox2.Clear
uf = Sheets("Datos").Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To uf
If Sheets("Datos").Cells(i, "A") = ComboBox1 Then
AddItem ComboBox2, Sheets("Datos").Cells(i, "B")
End If
Next

End Sub

Private Sub ComboBox6_Change()
f = ComboBox5.ListIndex + 2
TextBox1.Value = Sheets("Datos").Cells(f, "G")
TextBox1 = Format(TextBox1, "#,###.000")

End Sub

Private Sub CommandButton1_Click()
ComboBox1.Clear
uf = Sheets("Datos").Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To uf
AddItem ComboBox1, Sheets("Datos").Cells(i, "A")
Next
TextBox1.Value = Empty

End Sub

Sub AddItem(cmbBox As ComboBox, sItem As String)
For i = 0 To cmbBox.ListCount - 1
Select Case StrComp(cmbBox.List(i), sItem, vbTextCompare)
Case 0: Exit Sub
Case 1: cmbBox.AddItem sItem, i: Exit Sub
End Select
Next
cmbBox.AddItem sItem
End Sub

1 respuesta

Respuesta
2

Te anexo la macro completa para cargar los 6 combos dependientes y por último un dato en el textbox1.

Tienes que reemplazar tu macro por esta macro. Cuando modificas un combo, tienes que revisar los datos de todas las columnas, en el código que enviaste, por ejemplo, para el combo 4, sólo revisas el combo 3 y 4, y debes revisar el 1,2,3 y 4, de lo contrario estarás cargando información errónea.

Prueba esta macro con mucho más información para que lo revises.

Otro detalle que debes considerar, es que si tienes 2 ó más registros iguales en todas sus columnas, en el textbox1 solamente te pondrá el dato del primer registro.

Private Sub ComboBox1_Change()
    cargar 2
End Sub
Private Sub ComboBox2_Change()
    cargar 3
End Sub
Private Sub ComboBox3_Change()
    cargar 4
End Sub
Private Sub ComboBox4_Change()
    cargar 5
End Sub
Private Sub ComboBox5_Change()
    cargar 6
End Sub
Private Sub ComboBox6_Change()
'Por.Dante Amor
    For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
        For j = 1 To 6
            valor = IIf(IsNumeric(Controls("ComboBox" & j)), _
                Val(Controls("ComboBox" & j)), Controls("ComboBox" & j))
            If Cells(i, j) = valor Then
                igual = True
            Else
                igual = False
                Exit For
            End If
        Next
        If igual Then Exit For
    Next
    If igual Then TextBox1 = Cells(i, j)
End Sub
Private Sub UserForm_Activate()
'Por.Dante Amor
    For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
        agregar ComboBox1, Cells(i, "A")
    Next
End Sub
Sub agregar(combo As ComboBox, dato As String)
'Por.Dante Amor
    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
Sub cargar(ini)
'Por.Dante Amor
    TextBox1 = ""
    For i = ini To 6
        Controls("ComboBox" & i) = ""
        Controls("ComboBox" & i).Clear
    Next
    For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
        For j = 1 To ini - 1
            valor = IIf(IsNumeric(Controls("ComboBox" & j)), _
                Val(Controls("ComboBox" & j)), Controls("ComboBox" & j))
            If Cells(i, j) = valor Then
                igual = True
            Else
                igual = False
                Exit For
            End If
        Next
        If igual Then agregar Controls("ComboBox" & ini), Cells(i, ini)
    Next
End Sub

Estimado Dante

Gracias por tu pronta respuesta, efectivamente me funciona la macros que  me otorgas, pero pido un poco más de tu ayuda y experiencia, se me olvidó mencionar que los datos los tengo en otra hoja (hoja2) y el filtro lo hago en la hoja1 ¿es mucho el cambio que habría que hacer en la macro?

Otra consulta, no quiero usar un userform sino que los combobox directo en la hoja de Excel  como se muestra en la imagen que adjunte anteriormente ¿Es posible hacer eso?

Nuevamente agradezco tu tiempo y tus respuestas

Saludo cordiales

Te anexo la macro para cargar los combos en la hoja. El último detalle es que el año y el mes se tienen que verificar como valores numéricos

Private Sub ComboBox1_Change()
'Por.Dante Amor
    Set h2 = Sheets("Hoja2")
    ComboBox2. Clear
    ComboBox3. Clear
    ComboBox4. Clear
    ComboBox5. Clear
    ComboBox6. Clear
    TextBox1 = ""
    For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
        If h2.Cells(i, "A") = ComboBox1 Then
            agregar ComboBox2, h2.Cells(i, "B")
        End If
    Next
End Sub
'
Private Sub ComboBox2_Change()
'Por.Dante Amor
    Set h2 = Sheets("Hoja2")
    ComboBox3.Clear
    ComboBox4.Clear
    ComboBox5.Clear
    ComboBox6.Clear
    TextBox1 = ""
    For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
        If h2.Cells(i, "A") = ComboBox1 And _
           h2.Cells(i, "B") = ComboBox2 Then
            agregar ComboBox3, h2.Cells(i, "C")
        End If
    Next
End Sub
'
Private Sub ComboBox3_Change()
'Por.Dante Amor
    Set h2 = Sheets("Hoja2")
    ComboBox4.Clear
    ComboBox5.Clear
    ComboBox6.Clear
    TextBox1 = ""
    For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
        If h2.Cells(i, "A") = ComboBox1 And _
           h2.Cells(i, "B") = ComboBox2 And _
           h2.Cells(i, "C") = ComboBox3 Then
            agregar ComboBox4, h2.Cells(i, "D")
        End If
    Next
End Sub
'
Private Sub ComboBox4_Change()
'Por.Dante Amor
    Set h2 = Sheets("Hoja2")
    ComboBox5.Clear
    ComboBox6.Clear
    TextBox1 = ""
    For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
        If h2.Cells(i, "A") = ComboBox1 And _
           h2.Cells(i, "B") = ComboBox2 And _
           h2.Cells(i, "C") = ComboBox3 And _
           h2.Cells(i, "D") = ComboBox4 Then
            agregar ComboBox5, h2.Cells(i, "E")
        End If
    Next
End Sub
'
Private Sub ComboBox5_Change()
'Por.Dante Amor
    Set h2 = Sheets("Hoja2")
    ComboBox6.Clear
    TextBox1 = ""
    For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
        If h2.Cells(i, "A") = ComboBox1 And _
           h2.Cells(i, "B") = ComboBox2 And _
           h2.Cells(i, "C") = ComboBox3 And _
           h2.Cells(i, "D") = ComboBox4 And _
           h2.Cells(i, "E") = Val(ComboBox5) Then
            agregar ComboBox6, h2.Cells(i, "F")
        End If
    Next
End Sub
'
Private Sub ComboBox6_Change()
'Por.Dante Amor
    Set h2 = Sheets("Hoja2")
    TextBox1 = ""
    For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
        If h2.Cells(i, "A") = ComboBox1 And _
           h2.Cells(i, "B") = ComboBox2 And _
           h2.Cells(i, "C") = ComboBox3 And _
           h2.Cells(i, "D") = ComboBox4 And _
           h2.Cells(i, "E") = Val(ComboBox5) And _
           h2.Cells(i, "F") = Val(ComboBox6) Then
           TextBox1 = h2.Cells(i, "F")
        End If
    Next
End Sub
'
Sub agregar(combo As ComboBox, dato As String)
'Por.Dante Amor
    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
'
Private Sub ComboBox1_DropButtonClick()
'Por.Dante Amor
    Set h2 = Sheets("Hoja2")
    'ComboBox1.Clear
    For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
        agregar ComboBox1, h2.Cells(i, "A")
    Next
End Sub

Saludos.Dante Amor

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas