Excel 2013：VBA代码来筛选来自多个列表框select的工作表数据

我已经花了3天时间寻找解决scheme，我知道我很接近，但我没有得到我的问题，为什么发生。

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

我也有一个包含3个列表框（多选）的用户表单。 LB1 =职员名称，LB2 =项目缩写，LB3现在不重要。 我在这个用户窗体上也有3个button，1个用于重置LBselect，1个用于filter到电子表格，1个用于重置电子表格上的filter。

我的代码重置LBselect和电子表格上的filter工作得很好。 应用filter的人不会按照预期的方式工作。 到目前为止，这个button的代码看起来如下（现在只是试图处理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 

这是事情：

点击“应用filterbutton”将使电子表格中包含数据的所有行消失。 当我尝试debugging代码时，我发现自动筛选器的数组正确地填充了关于LBselect的内容。 当我点击应用在工作表上的filter的下拉列表，并转到“textfilter – > equals”，看看填充的过滤条件，就在那里。 它只是不会显示相应的行。 我尝试了很多东西，只是不知道问题在哪里。 另外，我只是一个VBA初学者试图弄清楚事情。 因此，任何帮助将不胜感激（以及当我想结合所有3列表框的select交给自动filter的情况下）！

真诚的，moshpit

编辑：

这是我目前的代码看起来像重写它确定algorithm。 我也debugging了整个事情。 有趣的是：在debugging过程中（当selectlistbox1 1个项目时），数组包含这个确切的值。 应用filter，并进入filter options dropdown -> textfilter -> equals ，没有价值，这让我假设这就是为什么它隐藏所有行。 但是，数组中的值是如何发生的，并且之后不会被应用到filter中？ 另外， Field:=应该是一个与Microsoft文档相关的可选参数，但是当我离开它时，它会给我一个运行时错误（错误＃1004：无法执行Range对象的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)传递给filter，而只传递arrMitarbeiter 。

2 – 如果你不使用xlFilterValues操作符，它只会过滤数组的最后一项，所以添加这个操作符。

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

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