在级联 ComboBox 和 ListBox1 中显示筛选的数据

Show Filtered Data in Cascaded ComboBoxes and ListBox1

提问人:Shiela 提问时间:10/8/2023 更新时间:10/8/2023 访问量:62

问:

我在这里有级联的 ComboBoxes 过滤后,将在 ListBox1 中正确显示。以下是我的 Sheet1 数据(请不要介意它们的排列方式,因为它们有目的,我将在这些空白单元格上添加更多数据):

Sheet1 data

Sheet1 原始数据:

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

现在我的挑战是,ComboBoxes 2-5 在过滤过程中没有列出预期数据。正如你在下面看到的,我是这样过滤的,但在 ComboBox 4 中增加了一个月:

Gary filter

当它应该只在本月时(在工作表中手动过滤时):

only august month

我在下面为另一个名称做了另一个过滤器,但 ComboBox5 显示所有独特的形状,而不仅仅是心形。

all shapes are showing

ComboBox5 的预期结果(在工作表中手动筛选时):

should be heart only

这是我的级联 ComboBox 代码:

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

我的 ComboBoxes 代码中可能出了什么问题,以至于在过滤过程中没有按预期获得正确的列表?而且我还没有代码可以在 ListBox1 中显示过滤后的数据。我想要的输出是在 ComboBox5 更改期间在 ListBox1 中显示具有完整列(包括空白列,因为我将在这些空白中放置一些数据以仅与筛选的条目一起显示)的过滤条目,就像下面的这个一样,除了它应该在 ListBox1 中。请帮忙。先谢谢你。

expected outcome

Excel VBA 筛选器 组合框 列表框

评论


答:

1赞 taller 10/8/2023 #1

您需要修复 change 事件的子句。IfComboBox2, ComboBox3 and ComboBox4

  • 该语句的行为不符合预期。 条件子句尝试同时比较三个值。该条件将评估这些值中的任何一个是否不匹配。例如,如果 ,那么将是 ,导致子句的执行。它用额外的物品填充下一级组合框。IfIfFalsercell = ComboBox1.Valuecondition1 And condition2 And condition3FalseElse
' 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
  • 返回 是字符串。 是一个数字。条件语句中需要转换。ComboBox2.Valuercell.Offset(0, -1)

该语句应如下所示。和事件代码都应更新。顺便说一句,不需要。IfComboBox3ComboBox4Offset(0, 0)

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

如果您有任何疑问,请查看您之前的帖子,了解如何用数组填充列表框。

如何显示列表框中的最后 10 个条目,制作为 VBA

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

评论

0赞 Shiela 10/8/2023
好的,我会试试这个 BRB
0赞 Shiela 10/8/2023
这太棒了!!