Início / coding / Perguntas / 77252533
Accepted
Shiela
Asked: 2023-10-08 14:16:29 +0800 CST

Mostrar dados filtrados em ComboBoxes em cascata e ListBox1

  • 772

Eu tenho aqui ComboBoxes em cascata quando filtrados, serão exibidos corretamente no ListBox1. Abaixo estão meus dados da Planilha1 (não se importe como eles estão organizados, pois têm uma finalidade e adicionarei mais dados nessas células em branco):

Dados da planilha1

Dados brutos da planilha 1:

Col. A    Col. B   Col. G    Col. J    Col. L
YEAR    || NAME || COLOR || MONTH    || SHAPE
2023    || LINA || GREEN || AUGUST   || HEART
2023    || LINA || GREEN || SEPTEMBER|| CIRCLE
2024    || GARY || GREEN || SEPTEMBER|| DIAMOND
2024    || GARY || RED   || AUGUST   || OVAL
2023    || GARY || RED   || AUGUST   || RECTANGLE
2023    || GARY || GREEN || AUGUST   || SQUARE
2024    || GARY || GREEN || SEPTEMBER|| STAR
2024    || TOM  || RED   || AUGUST   || HEART
2024    || TOM  || RED   || SEPTEMBER|| CIRCLE
2024    || TOM  || RED   || SEPTEMBER|| DIAMOND
2024    || TOM  || YELLOW|| SEPTEMBER|| OVAL
2024    || TOM  || YELLOW|| OCTOBER  || RECTANGLE
2024    || TOM  || BLUE  || OCTOBER  || SQUARE

Agora, meu desafio é que os ComboBoxes 2 a 5 não listam os dados esperados durante o filtro. Como você pode ver abaixo, filtrei desta forma, mas há um mês adicional adicionado no ComboBox 4:

Filtro Gary

Quando deveria ser apenas neste mês (quando filtrado manualmente na planilha):

só mês de agosto

Além disso, fiz outro filtro para outro nome abaixo, mas o ComboBox5 está mostrando todas as formas exclusivas em vez de apenas o Coração.

todas as formas estão aparecendo

Resultado esperado para ComboBox5 (quando filtrado manualmente na planilha):

deveria ser apenas coração

Este é o meu código para os ComboBoxes em cascata:

Option Explicit
Private Sub ComboBox4_Change()
''''''**************************** Different Tasks Not Equal to No Ticket
  If Not ComboBox4.Value = "" Then
    With Me.ComboBox5
        .Enabled = True
        .BackColor = &HFFFF&
        
        Dim ws As Worksheet
        Dim rcell As Range, Key
        Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")
        Set ws = Worksheets("Sheet1")
            
        .Clear
        .Value = vbNullString
        
            For Each rcell In ws.Range("B2", ws.Cells(Rows.count, "B").End(xlUp))
                    If rcell.Offset(0, 0) <> ComboBox1.Value And rcell.Offset(0, -1) <> ComboBox2.Value And rcell.Offset(0, 5) <> ComboBox3.Value And rcell.Offset(0, 8) <> ComboBox4.Value Then
                    Else
                        If Not dic.Exists(rcell.Offset(, 10).Value) Then
                            dic.Add rcell.Offset(, 10).Value, Nothing
                        End If
                    End If
            Next rcell
            For Each Key In dic
                Me.ComboBox5.AddItem Key
            Next
    End With
Else
     With Me.ComboBox5
     .Clear
    .Enabled = False
    .BackColor = &HFFFFFF
    End With
End If
End Sub
Private Sub ComboBox3_Change()
If Not ComboBox3.Value = "" Then
    With Me.ComboBox4
        .Enabled = True
        .BackColor = &HFFFF&
        
        Dim ws As Worksheet
        Dim rcell As Range, Key
        Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")
        Set ws = Worksheets("Sheet1")
            
        .Clear
        .Value = vbNullString
        
            For Each rcell In ws.Range("B2", ws.Cells(Rows.count, "B").End(xlUp))
                    If rcell.Offset(0, 0) <> ComboBox1.Value And rcell.Offset(0, -1) <> ComboBox2.Value And rcell.Offset(0, 5) <> ComboBox3.Value Then
                    Else
                        If Not dic.Exists(rcell.Offset(, 8).Value) Then
                            dic.Add rcell.Offset(, 8).Value, Nothing
                        End If
                    End If
            Next rcell
            For Each Key In dic
                Me.ComboBox4.AddItem Key
            Next
    End With
    Me.ComboBox5.Clear
Else
     With Me.ComboBox4
     .Clear
    .Enabled = False
    .BackColor = &HFFFFFF
    End With
    Me.ComboBox5.Clear
End If
End Sub

Private Sub ComboBox2_Change()
If Not ComboBox2.Value = "" Then
    With Me.ComboBox3
        .Enabled = True
        .BackColor = &HFFFF&
        
        Dim ws As Worksheet
        Dim rcell As Range, Key
        Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")
        Set ws = Worksheets("Sheet1")
            
        .Clear
        .Value = vbNullString
        
            For Each rcell In ws.Range("B2", ws.Cells(Rows.count, "B").End(xlUp))
                    If rcell.Offset(0, 0) <> ComboBox1.Value And rcell.Offset(0, -1) <> ComboBox2.Value Then
                    
                    Else
                        If Not dic.Exists(rcell.Offset(, 5).Value) Then
                            dic.Add rcell.Offset(, 5).Value, Nothing
                        End If
                    End If
               ' Next rYear
            Next rcell
            For Each Key In dic
                Me.ComboBox3.AddItem Key
            Next
    End With
        Me.ComboBox4.Clear
        Me.ComboBox5.Clear
Else
     With Me.ComboBox3
     .Clear
    .Enabled = False
    .BackColor = &HFFFFFF
    End With
    Me.ComboBox4.Clear
    Me.ComboBox5.Clear
End If

End Sub
Private Sub ComboBox1_Change() 'done
If Not ComboBox1.Value = "" Then
    With Me.ComboBox2
        .Enabled = True
        .BackColor = &HFFFF&
        
        Dim ws As Worksheet
        Dim rcell As Range, Key
        Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")
        Set ws = Worksheets("Sheet1")
            
        .Clear
        
            For Each rcell In ws.Range("B2", ws.Cells(Rows.count, "B").End(xlUp))
                    If rcell.Value = ComboBox1.Value Then
                        If Not dic.Exists(rcell.Offset(, -1).Value) Then
                            dic.Add rcell.Offset(, -1).Value, Nothing
                        End If
                    End If
            Next rcell
            For Each Key In dic
                Me.ComboBox2.AddItem Key
            Next
    End With
        Me.ComboBox3.Clear
        Me.ComboBox4.Clear
        Me.ComboBox5.Clear
Else
     With Me.ComboBox2
     .Clear
    .Enabled = False
    .BackColor = &HFFFFFF
    End With
    Me.ComboBox3.Clear
    Me.ComboBox4.Clear
    Me.ComboBox5.Clear

End If

End Sub

Private Sub UserForm_Initialize()
    
Dim ws As Worksheet
Dim rcell As Range
'dim dic as Object: set dic = createobject("Scripting.Dictionary")
Set ws = Worksheets("Sheet1")

ComboBox1.Clear

With CreateObject("scripting.dictionary")
For Each rcell In ws.Range("B2", ws.Cells(Rows.count, "B").End(xlUp))
If Not .Exists(rcell.Value) Then
.Add rcell.Value, Nothing
End If
Next rcell
ComboBox1.List = .Keys

End With
    With Me.ComboBox2
    .Enabled = False
    .BackColor = &HFFFFFF
    End With
    With Me.ComboBox3
    .Enabled = False
    .BackColor = &HFFFFFF
    End With
    With Me.ComboBox4
    .Enabled = False
    .BackColor = &HFFFFFF
    End With
    With Me.ComboBox5
    .Enabled = False
    .BackColor = &HFFFFFF
    End With
End Sub

O que poderia dar errado nos meus códigos ComboBoxes para não obter a lista correta conforme o esperado durante o filtro? E ainda não tenho um código para mostrar os dados filtrados no ListBox1. Minha saída desejada é mostrar as entradas filtradas com colunas completas (incluindo as colunas em branco, já que colocarei alguns dados nesses espaços em branco apenas para fins de exibição junto com as entradas filtradas) em ListBox1 durante a alteração do ComboBox5 como esta abaixo, exceto que deveria estar em ListBox1. Por favor ajude. Agradeço antecipadamente.

resultado esperado

excel

1 respostas

  1. Best Answer

    Você precisa corrigir a Ifcláusula para ComboBox2, ComboBox3 and ComboBox4o evento de mudança.

    • A Ifinstrução não se comporta conforme o esperado. A Ifcláusula de condição tenta comparar três valores simultaneamente. A condição será avaliada Falsese algum desses valores for incompatível. Por exemplo, se rcell = ComboBox1.Value, então condition1 And condition2 And condition3será False, levando à execução da Elsecláusula. Ele preenche a caixa de combinação do próximo nível com itens extras.
    ' If condition1 And condition2 And condition3 Then
If rcell.Offset(0, 0) <> ComboBox1.Value And rcell.Offset(0, -1) <> ComboBox2.Value And rcell.Offset(0, 5) <> ComboBox3.Value Then
Else
    If Not dic.Exists(rcell.Offset(, 8).Value) Then
        dic.Add rcell.Offset(, 8).Value, Nothing
    End If
End If
    • O retorno de ComboBox2.Valueé string. rcell.Offset(0, -1)é um número. A conversão é necessária na declaração de condição.

    A Ifdeclaração deve ser conforme mostrado abaixo. Ambos ComboBox3e ComboBox4o código do evento devem ser atualizados. aliás, Offset(0, 0)não é necessário.

    Private Sub ComboBox3_Change()
    If Not ComboBox3.Value = "" Then
        With Me.ComboBox4
            ' your code
            For Each rcell In ws.Range("B2", ws.Cells(Rows.Count, "B").End(xlUp))
                If rcell = ComboBox1.Value And rcell.Offset(0, -1) = CStr(ComboBox2.Value) And rcell.Offset(0, 5) = ComboBox3.Value Then
                    If Not dic.Exists(rcell.Offset(, 8).Value) Then
                        dic.Add rcell.Offset(, 8).Value, Nothing
                    End If
                End If
            Next rcell
            For Each Key In dic
                Me.ComboBox4.AddItem Key
            Next
        End With
        ' your code 
End Sub

    Por favor, verifique sua postagem anterior para saber como preencher a caixa de listagem com um array se tiver dúvidas.

    Como mostrar as últimas 10 entradas no listbox feito em VBA

    Código de evento para combobox5.

    Private Sub ComboBox5_Change()
    If Not ComboBox5.Value = "" Then
        Dim ws As Worksheet
        Dim rcell As Range, Key
        Dim arrData, arrList(), i As Long, j As Long
        Set ws = Worksheets("Sheet1")
        arrData = ws.Range("A1:L" & ws.Cells(Rows.Count, "B").End(xlUp).Row)
        ReDim arrList(1 To 2, 1 To UBound(arrData, 2))
        For j = 1 To UBound(arrData, 2)
            arrList(1, j) = arrData(1, j)
        Next
        For i = 2 To UBound(arrData)
            If arrData(i, 2) = ComboBox1.Value And arrData(i, 1) = CStr(ComboBox2.Value) _
                And arrData(i, 7) = ComboBox3.Value And arrData(i, 10) = ComboBox4.Value _
                And arrData(i, 12) = ComboBox5.Value Then
                For j = 1 To UBound(arrData, 2)
                    arrList(2, j) = arrData(i, j)
                Next
                Exit For
            End If
        Next
        With Me.ListBox1
            .ColumnHeads = False
            .ColumnCount = UBound(arrData, 2)
            .List = arrList
        End With
    End If
End Sub
    • 1

relate perguntas