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

Question

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

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

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

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

' 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

事情是这样的：

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

真诚地， 小窝

编辑：

这就是我当前的代码的样子，重写它以确保算法。我也调试了整个事情。有趣的是：在调试过程中（选择listbox1 中的一项），数组包含这个精确值。应用过滤器并转到filter options dropdown -> textfilter -> equals 后，那里没有任何值，这让我认为这就是它隐藏所有行的原因。但是为什么值在数组中并且之后没有应用于过滤器？此外，Field:= 应该是有关 Microsoft 文档的可选参数，但是当我忽略它时，它会给我一个运行时错误（错误＃ 1004：无法执行范围对象的 AutoFilter 方法）。

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

Answer 1

里面有两个问题：

1 - arrMitarbeiter 已经是您在 Dim arrMitarbeiter() As Variant 中定义的数组

因此，您不能将Array(arrMitarbeiter) 传递给过滤器，而只能传递arrMitarbeiter。

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

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

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