主页 / coding / 问题 / 77252533
Accepted
Shiela
Asked: 2023-10-08 14:16:29 +0800 CST

在级联组合框和列表框 1 中显示过滤后的数据

  • 772

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

Sheet1 数据

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

现在我的挑战是，组合框 2-5 在过滤期间没有列出预期数据。正如您在下面看到的，我以这种方式过滤了它，但在 ComboBox 4 中添加了一个额外的月份：

加里过滤器

何时应该仅在本月（在工作表中手动过滤时）：

仅八月

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

所有形状都显示出来

ComboBox5 的预期结果（在工作表中手动过滤时）：

应该只是心

这是我的级联组合框代码：

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 中。请帮忙。先感谢您。

预期结果

excel

1 个回答

  1. Best Answer

    您需要修复更改事件If的子句ComboBox2, ComboBox3 and ComboBox4。

    • 该If语句的行为不符合预期。条件If子句尝试同时比较三个值。条件将评估False这些值中是否有任何不匹配。例如， if rcell = ComboBox1.Value, then condition1 And condition2 And condition3will be False，导致Else子句的执行。它用额外的项目填充下一级组合框。
    ' 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.Value是字符串。rcell.Offset(0, -1)是一个数字。条件语句中需要进行转换。

    该If语句应如下所示。ComboBox3和事件代码都ComboBox4应该更新。顺便说一句，Offset(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

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

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

    组合框 5 的事件代码。

    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

相关问题