Excel 2013：用于从多个列表框选择中筛选工作表数据的VBA代码

我花了3天时间寻找解决方案，我知道我已经接近了，但我不明白我的问题以及为什么会发生

首先，我有一个电子表格，其中包含员工姓名（a列，从第5行开始）和资源规划数据（项目缩写），从B列到HG。每个列（A列除外）表示日历中的一天（列标题为日期）

我还有一个包含3个列表框（multiselect）的用户表单。LB1=员工姓名，LB2=项目缩写，LB3暂时不重要。我在这个用户表单上还有3个按钮，1个用于重置LB选择，1个用于将过滤器应用于电子表格，1个用于重置电子表格上的过滤器

我用于重置LB选择和电子表格上的过滤器的代码工作正常。应用过滤器的那个不会按预期的方式工作。到目前为止，此按钮的代码如下所示（目前仅尝试处理1磅）：

事情是这样的：

点击“应用过滤器按钮”会使电子表格中包含数据的所有行消失。当我尝试调试代码时，我看到自动过滤器的数组在LB选择方面得到了正确填充。当我点击工作表上应用的过滤器下拉列表，进入“textfilter->equals”查看填充的过滤器条件时，它就在那里。它只是不显示相应的行。我尝试了很多东西，但我不知道问题出在哪里。另外，我只是一个VBA初学者，试图找出问题的答案。因此，任何帮助都将不胜感激（对于我希望将所有3个列表框的选择组合起来，以将其交给自动筛选的情况也是如此）

真诚地， 莫斯比特

编辑：

---

这就是我当前的代码，重写它以确定算法。我还调试了整个程序。有趣的是：在调试期间（当

列表框1

中的1项被选中时），数组包含了这个精确的值。应用过滤器并转到

过滤器选项下拉列表->文本过滤器->等于
后，其中没有值，这使我假设这就是它隐藏所有行的原因。但是，为什么该值在数组中，之后不应用于过滤器？另外，
Field:=
应该是有关Microsoft文档的可选参数，但当我省略该参数时，它会给我一个运行时错误（错误#1004：无法执行范围对象的自动筛选方法）

选项显式
'将筛选器应用于工作表
私有子命令按钮2_单击（）
Dim x（）作为字符串，r（）作为字符串，k（）作为字符串
尺寸i为整数，j为整数，s为整数
雷迪姆x（0）
Application.ScreenUpdating=False
ActiveSheet.UsedRange.AutoFilter
'ListBox1的筛选器数组
对于ListBox1.ListCount-1的i=0
如果Me.ListBox1.Selected（i）=True，则
x（UBound（x））=Me.ListBox1.List（i）
重读保留x（UBound（x）+1）
如果结束
接下来我
如果UBound（x）0，则
工作表（“表1”）。范围（“A1”）。自动筛选字段：=1，准则1:=x，运算符：=xlFilterValues
重拨保留x（UBound（x）-1）
如果结束
雷迪姆r（0）
'ListBox2的筛选器数组
对于j=0到ListBox2.ListCount-1
如果Me.ListBox2.Selected（j）=True，则
r（UBound（r））=Me.ListBox2.List（j）
重读保留r（UBound（r）+1）
如果结束
下一个j
如果UBound（r）0，则
重播保留r（UBound（r）-1）
工作表（“表1”）。范围（“B1:HG1”）。自动筛选，准则1:=r，运算符：=XLFilterValue
如果结束
雷迪姆k（0）
'ListBox3的筛选器数组
对于s=0到ListBox3.ListCount-1
如果Me.ListBox3.Selected（s）=True，则
k（UBound（k））=Me.ListBox3.List
重读保留k（UBound（k）+1）
如果结束
下一个s
如果UBound（k）0那么
重读保留k（UBound（k）-1）
工作表（“表1”）。自动筛选，准则1:=k，运算符：=xlFilterValues
如果结束
Application.ScreenUpdating=True
端接头
'重置过滤器掩码
私有子命令按钮1_单击（）
Dim iCount1为整数
Dim iCount2为整数
Dim iCount3为整数
对于我来说，iCount1=0！ListBox1.ListCount-1
我ListBox1.Selected（iCount1）=False
下一个图标1
对于我来说，iCount2=0！ListBox2.ListCount-1
我ListBox2.Selected（iCount2）=False
下一个iCount2
对于我来说，iCount3=0！ListBox3.ListCount-1
我ListBox3.Selected（iCount3）=False
下一个iCount3
端接头
'从工作表中删除筛选器
私有子命令按钮3_单击（）
出错时继续下一步
ActiveSheet.ShowAllData
端接头
其中有两个问题：

1-
arrMitarbeiter
已经是一个数组，正如您在
Dim arrMitarbeiter（）中定义的，它是一个变体

因此，您不能将
Array（arrMitarbeiter）
传递给过滤器，而是只传递
arrMitarbeiter

2-如果不使用
xlFilterValues
运算符，它将只过滤数组的最后一项，因此添加此运算符

修正这一行（我做了两行只是为了阅读）：

其中有两个问题：

1-
arrMitarbeiter
已经是一个数组，正如您在
Dim arrMitarbeiter（）中定义的，它是一个变体

因此，您不能将
Array（arrMitarbeiter）
传递给过滤器，而是只传递
arrMitarbeiter

2-如果不使用
xlFilterValues
运算符，它将只过滤数组的最后一项，因此添加此运算符

修正这一行（我做了两行只是为了阅读）：

您是否尝试获取与
UsedRange
不同的范围？我想
UsedRange
从第1行获取单元格。如果在1和5之间有空行，那么过滤器可能会显示一些奇怪的行为。我应该尝试一下。
' Apply filter to spreadsheet
Private Sub CB_FilterActive_Click()
    Dim arrMitarbeiter() As Variant
    Dim i As Integer, count As Integer

    count = 1
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            ReDim Preserve arrMitarbeiter(count)
            arrMitarbeiter(count) = ListBox1.List(i)
            count = count + 1
        End If
    Next i
    Worksheets("Einsatzplan").UsedRange.Cells.AutoFilter field:=1, Criteria1:=Array(arrMitarbeiter)
End Sub

Option Explicit

' Apply Filter to Sheet
Private Sub CommandButton2_Click()
    Dim x() As String, r() As String, k() As String
    Dim i As Integer, j As Integer, s As Integer

    ReDim x(0)

    Application.ScreenUpdating = False
    ActiveSheet.UsedRange.AutoFilter

    ' Filter Array for ListBox1
    For i = 0 To ListBox1.ListCount - 1
        If Me.ListBox1.Selected(i) = True Then
            x(UBound(x)) = Me.ListBox1.List(i)
            ReDim Preserve x(UBound(x) + 1)
        End If
    Next i
    If UBound(x) <> 0 Then
        Worksheets("Tabelle1").Range("A1").AutoFilter Field:=1, Criteria1:=x, Operator:=xlFilterValues
        ReDim Preserve x(UBound(x) - 1)
    End If

    ReDim r(0)

    ' Filter Array for ListBox2
    For j = 0 To ListBox2.ListCount - 1
        If Me.ListBox2.Selected(j) = True Then
            r(UBound(r)) = Me.ListBox2.List(j)
            ReDim Preserve r(UBound(r) + 1)
        End If
    Next j
    If UBound(r) <> 0 Then
        ReDim Preserve r(UBound(r) - 1)
        Worksheets("Tabelle1").Range("B1 : HG1").AutoFilter , Criteria1:=r, Operator:=xlFilterValues
    End If

    ReDim k(0)

    ' Filter Array for ListBox3
    For s = 0 To ListBox3.ListCount - 1
        If Me.ListBox3.Selected(s) = True Then
            k(UBound(k)) = Me.ListBox3.List(s)
            ReDim Preserve k(UBound(k) + 1)
        End If
    Next s
    If UBound(k) <> 0 Then
        ReDim Preserve k(UBound(k) - 1)
        Worksheets("Tabelle1").AutoFilter , Criteria1:=k, Operator:=xlFilterValues
    End If

    Application.ScreenUpdating = True

End Sub

' Reset Filter Mask
Private Sub CommandButton1_Click()
    Dim iCount1 As Integer
    Dim iCount2 As Integer
    Dim iCount3 As Integer

    For iCount1 = 0 To Me!ListBox1.ListCount - 1
        Me!ListBox1.Selected(iCount1) = False
    Next iCount1

    For iCount2 = 0 To Me!ListBox2.ListCount - 1
        Me!ListBox2.Selected(iCount2) = False
    Next iCount2

    For iCount3 = 0 To Me!ListBox3.ListCount - 1
        Me!ListBox3.Selected(iCount3) = False
    Next iCount3
End Sub

' Delete Filter from Sheet
Private Sub CommandButton3_Click()
    On Error Resume Next
    ActiveSheet.ShowAllData
End Sub

Worksheets("Einsatzplan").UsedRange.Cells.AutoFilter 
     field:=1, Criteria1:=arrMitarbeiter, Operator:=xlFilterValues