从列表框中选择的项目是表中的过滤器 .criteria1

问题描述

在活动 workbook.Sheets(1) 中，我有一个 ListBoxes("List Box 1")。 首先我从这个 ListBoxes 中选择项目，然后我想在第二个工作表中过滤表（“表 1”）。 我不知道为什么它不起作用。

'''

Sub group()

Dim i,j As Long
Dim lastrow As Long
Dim wb As Workbook
Dim wbNew As Workbook
Dim ListaI As Object 'listBox
Dim Wynik As String

Set wb = ActiveWorkbook

lastrow = WorksheetFunction.CountA(wb.Sheets(3).Columns("A:A")) 'in this column is a list of items


Set ListaI = wb.Sheets(1).ListBoxes("List Box 1") ' this listBox include value from wb.Sheets(3).Columns("A:A")

For i = 2 To lastrow
If ListaI.Selected(i) Then
    j = j + 1
    If j > 1 Then Wynik = Wynik ' to omit empty
    Wynik = Wynik & Chr(34) & ListaI.List(i) & Chr(34) & ","
    
    
 End If
 Next


Wynik = Left(Wynik,Len(Wynik) - 2) ' to delite last comma,for example: "pen","window","door"


Set wbNew = Workbooks.Open(Filename:="C:\Users\username\Desktop\nameofphile.xlsx",ReadOnly:=True)

With wbNew.Sheets("name")
    .ListObjects("table 1").Range.AutoFilter Field:=1,Criteria1:=Wynik,_
     Operator:=xlFilterValues ' assigning selected values to a filter in a table
    
End With




End Sub

'''

解决方法

一些建议：

• 将变量命名为有意义的名称（我很难理解，反之更容易）
• 正确缩进您的代码（您可以使用 Rubberduckvba.com）来帮助您处理数据
• 尝试将您的代码分解成多个部分（例如，首先设置引用，然后设置计数器，然后创建过滤器数组，然后应用它）
• 评论你的代码

---

阅读代码的注释并根据您的需要进行调整

代码：

Option Explicit

Public Sub FilterTableBySelectedItem()
    
    ' Set a referece to the workbook holding the listbox
    Dim sourceWorkbook As Workbook
    Set sourceWorkbook = ActiveWorkbook
    
    ' Set a reference to the worksheet holding the listbox
    Dim sourceSheet As Worksheet
    Set sourceSheet = sourceWorkbook.Worksheets("Sheet1")
    
    ' Set a reference to the listbox
    Dim sourceListbox As ListBox
    Set sourceListbox = sourceSheet.ListBoxes("List Box 1")
    
    ' Get total selected items in listbox
    Dim counter As Long
    For counter = 1 To sourceListbox.ListCount
        If sourceListbox.Selected(counter) Then
            Dim totalSelected As Long
            totalSelected = totalSelected + 1
        End If
    Next counter
    
    ' Add the selected items to an array
    Dim selectedItems As Variant
    ReDim selectedItems(totalSelected - 1)
    For counter = 1 To sourceListbox.ListCount
        If sourceListbox.Selected(counter) Then
            Dim selectedCounter As Long
            selectedItems(selectedCounter) = sourceListbox.List(counter)
            selectedCounter = selectedCounter + 1
        End If
    Next counter
    
    ' Uncomment this next lines if you plan to use the filter in another way,'Dim selectedItemsFilter As String
    'selectedItemsFilter = Join(selectedItems,",")
    
    ' Set a reference to the workbook holding the table
    Dim targetWorkbook As Workbook
    Set targetWorkbook = Workbooks.Open(Filename:="C:\Temp\test.xlsx",ReadOnly:=True)
    
    ' Set a reference to the worksheet holding the table
    Dim targetSheet As Worksheet
    Set targetSheet = targetWorkbook.Worksheets("Sheet1")
    
    ' Set a reference to the table
    Dim targetTable As ListObject
    Set targetTable = targetSheet.ListObjects("Table1")
    
    ' Filter the table using the array of selected items
    targetTable.Range.AutoFilter Field:=1,Criteria1:=selectedItems,Operator:=xlFilterValues

End Sub

让我知道它是否有效