ListBox 中的 ComboBox 更改事件结果-解网

问：

这是从这里开始的更新问题。这篇文章的答案非常有效，特别是对于级联组合框更改。我只是在 ListBox1 中根据上次更改事件中 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 || GREEN || SEPTEMBER|| RECTANGLE
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  || YELLOW|| OCTOBER  || CIRCLE
2024    || TOM  || YELLOW|| OCTOBER  || SQUARE
2024    || TOM  || YELLOW|| OCTOBER  || STAR
2024    || TOM  || YELLOW|| OCTOBER  || STAR
2024    || TOM  || BLUE  || OCTOBER  || SQUARE

原始数据的图像（此处的空白有目的）：

更改事件的代码：

Private Sub ComboBox4_Change()
    If Not ComboBox4.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 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
            .ColumnWidths = "35,35,0,0,0,0,40,0,0,50,0,50"
            .ColumnCount = UBound(arrData, 2)
            .List = arrList
        End With
    End If
End Sub

如您所见，使用上面的更改事件代码仅返回 1 行数据（如果我在 2024 年选择黄色和 10 月份的 Tom），而它应该返回更多行以在 ListBox1 中显示，因为它有多个形状（如果形状在 Sheet1 中重复，则很好）：

我想要的输出是这样的（在 Sheet1 中手动过滤时）：

更改事件代码中应更改哪些内容以更正此问题。感谢您的帮助。

Excel VBA 组合框

Private Sub ComboBox4_Change()
    If Not ComboBox4.Value = "" Then
        Dim ws As Worksheet
        Dim rcell As Range, iIdx As Integer
        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 Preserve arrList(1 To UBound(arrData, 2), 1 To 1)
        For j = 1 To UBound(arrData, 2)
            arrList(j, 1) = arrData(1, j)
        Next
        iIdx = 1
        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 Then
                iIdx = iIdx + 1
                ReDim Preserve arrList(1 To UBound(arrData, 2), 1 To iIdx)
                For j = 1 To UBound(arrData, 2)
                    arrList(j, iIdx) = arrData(i, j)
                Next
            End If
        
        Next
        With Me.ListBox1
            .ColumnHeads = False
            .ColumnWidths = "35,35,0,0,0,0,40,0,0,50,0,50"
            .ColumnCount = UBound(arrData, 2)
            .List = Application.Transpose(arrList)
        End With
    End If
End Sub

请允许我对你的工作代码进行一些提示（使用转置的行/列元素）：我会首先（重新）维度到它的最大边界（），并且只在主循环之外进行第二次。- 它可能对其他用户有指导意义，因为您知道您可以避免通过 listboxe 的属性重新转置：@taller_ExcelHomearrListarrListReDim Preserve arrList(1 To UBound(arrData, 2), 1 To UBound(arrData, 1)) ReDim Preserve arrList(1 To UBound(arrData, 2), 1 To idx) .Column.Column = arrList

0赞 T.M. 10/10/2023

也许对我几年前遇到该属性感兴趣：如何加快在用户窗体上填充列表框值@taller_ExcelHome.Column

0赞 taller 10/10/2023

@T.M. 谢谢你的分享。我不明白为什么 redim array 更好.its maximum boundaries

3赞 FaneDuru 10/9/2023 #2

请尝试下一个改编的代码：

Private Sub ComboBox4_Change()
    If Not ComboBox4.value = "" Then
        Dim ws As Worksheet, rng As Range, count As Long, K As Long
        Dim arrData, arrList(), i As Long, j As Long
        Set ws = Worksheets("Sheet1")
        
        Set rng = ws.Range("A1:L" & ws.cells(rows.count, "B").End(xlUp).Row)
        arrData = rng.value

        'determine the necessary number of final array rows:
        count = WorksheetFunction.CountIfs(rng.Columns(1), CStr(ComboBox2.value), rng.Columns(2), ComboBox1.value, rng.Columns(7), ComboBox3.value, rng.Columns(10), ComboBox4.value)
        ReDim arrList(1 To count + 1, 1 To UBound(arrData, 2))
        For j = 1 To UBound(arrData, 2)
            arrList(1, j) = arrData(1, j) 'the header
        Next
        K = 1
        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 Then
                K = K + 1
                For j = 1 To UBound(arrData, 2)
                    arrList(K, j) = arrData(i, j) 'matching data
                Next
            End If
        
        Next
        With Me.ListBox1
            .ColumnHeads = False
            .ColumnWidths = "35,35,0,0,0,0,40,0,0,50,0,50"
            .ColumnCount = UBound(arrData, 2)
            .List = arrList
        End With
    End If
End Sub

ListBox 中的 ComboBox 更改事件结果

ComboBox change event result in ListBox

评论

评论

评论