根据组合框过滤列表框 [英] Filter a listbox based on combobox

问题描述

我正在根据组合框选择来过滤列表框.目前，我的代码看起来像这样.

I am working on filtering a listbox based on the combobox selection. Currently my codes look something like this.

Private Sub OEMNumberComboBox_Change()
Dim database(1 To 100, 1 To 7)
Dim i As Integer
Dim My_range As Integer
Dim colum As Byte
On Error Resume Next
Sheet7.Range("A1").AutoFilter field:=3, Criteria1:=Me.OEMNumberComboBox.Value

For i = 2 To Sheet7.Range("A100000").End(xlUp).Row
If Sheet7.Cells(i, 3) = Me.OEMNumberComboBox Then

    My_range = My_range + 1
    For colum = 1 To 7
    database(My_range, colum) = Sheet7.Cells(i, colum)
    Next colum
End If
Next i
ListBox1.List = database
End Sub

以及以下初始化过程中的内容

and the below during the intialisation

Sub Available_Stocks()
Application.ScreenUpdating = False
Dim invd_sh As Worksheet
Set invd_sh = ThisWorkbook.Sheets("Inventory")
Dim lr As Integer
lr = Application.WorksheetFunction.CountA(invd_sh.Range("A:A"))
If lr = 1 Then lr = 2
With Me.ListBox1
   .ColumnCount = 9
   .ColumnHeads = True
   .ColumnWidths = "50,60,60,350,50,0,0,50,50"
   .RowSource = "Inventory!A2:I" & lr
End With
End Sub

使用上面的代码，它会过滤范围，但不会反映在列表框中，并且我不确定代码有什么问题.它是在线代码的精确副本，但我做了一些修改(以便它过滤C列).

with the above codes it does filter the range but it is not reflected on the listbox and I am not sure what is wrong with the code. It is exact copy of the online codes but i have made a slight modification (so that it is filtering column C).

用户界面/对象

更新

Private Sub UserForm_Initialize()
'add column of data from spreadsheet to your userform ComboBox
OEMNumberComboBox.List = Sheets("Sheet1").Range("C1:C50").Value
End Sub

我已经添加了上面的代码来填充组合框，但是它仍然显示列表框内的一个单元格

I have added the above code to populate the combobox but it sill shows one cell inside the listbox

推荐答案

出于演示目的，假设您的工作表如下所示，我想填充列C的值为 1

For demonstration purpose, let's say your worksheet looks like the below and I want to populate all cells where the value of column C is 1

逻辑:

1. 声明一个 Variant 数组.
2. 使用组合框中的相关值过滤 C 列.
3. 遍历过滤范围的 Areas 并填充数组.
4. 将数组分配给列表框的 .List .

1. Declare a Variant array.
2. Filter on column C with the relevant value from the combobox.
3. Loop through the Areas of the filtered range and populate the array.
4. Assign the array to the Listbox's .List.

代码:

这是您要绑的东西吗?我已对代码进行了注释，以便您在理解它时不会遇到问题.但是，如果您这样做，那就问一下.

Is this what you are tying? I have commented the code so that you should not have a problem understanding it. But if you do, then simply ask.

Option Explicit

Dim ws As Worksheet
Dim lrow As Long
Dim i As Long, j As Long

Private Sub UserForm_Initialize()
    '~~> Set this to the relevant worksheet
    Set ws = Sheet1
    
    '~~> Set the listbox column count
    ListBox1.ColumnCount = 8
    
    Dim col As New Collection
    Dim itm As Variant
    
    With ws
        '~~> Get last row in column C
        lrow = .Range("C" & .Rows.Count).End(xlUp).Row
        
        '~~> Create a unique list from column C values
        On Error Resume Next
        For i = 2 To lrow
            col.Add .Range("C" & i).Value2, CStr(.Range("C" & i).Value2)
        Next i
        On Error GoTo 0
        
        '~~> Add the item to combobox
        For Each itm In col
            OEMNumberComboBox.AddItem itm
        Next itm
    End With
End Sub

Private Sub CommandButton1_Click()
    '~~> If nothing selected in the combobox then exit
    If OEMNumberComboBox.ListIndex = -1 Then Exit Sub
    
    '~~> Clear the listbox
    ListBox1.Clear
    
    Dim DataRange As Range, rngArea As Range
    Dim DataSet As Variant
    
    With ws
        '~~> Remove any filters
        .AutoFilterMode = False
        
        '~~> Find last row in Col C
        lrow = .Range("C" & .Rows.Count).End(xlUp).Row
        
        '~~> Filter on the relevant column
        With .Range("C1:C" & lrow)
            .AutoFilter Field:=1, Criteria1:=OEMNumberComboBox.Value
            
            On Error Resume Next
            Set DataRange = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
            On Error GoTo 0
        End With
        
        '~~> Check if the autofilter returned any results
        If Not DataRange Is Nothing Then
            '~~> Instead of using another object, I am reusing the object
            Set DataRange = .Range("A2:G" & lrow).SpecialCells(xlCellTypeVisible)
            
            '~~> Create the array
            ReDim DataSet(1 To DataRange.Areas.Count + 1, 1 To 8)
            
            j = 1
            
            '~~> Loop through the area and store in the array
            For Each rngArea In DataRange.Areas
                For i = 1 To 8
                    DataSet(j, i) = rngArea.Cells(, i).Value2
                Next i
                j = j + 1
            Next rngArea
            
            '~~> Set the listbox list
            ListBox1.List = DataSet
        End If
        
        '~~> Remove any filters
        .AutoFilterMode = False
    End With
End Sub

实际操作:

这篇关于根据组合框过滤列表框的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！