选择与另一Excel工作表中的项目列表匹配的所有数据透视项目

Question

我有一张Excel工作表，其中包含人员及其相关部门的列表。在另一个工作表的数据透视表中，我希望筛选结果，以便显示"分配给"给定部门中任何人员的所有项目。

到目前为止，我已经有了将人员列表筛选到所需部门的代码，并将创建一个包含所有人员姓名的数组。然后，我尝试过滤包含这些名称列表的数据透视项，使其可见，并隐藏所有其他名称列表，但当我尝试运行宏时，它只是在不断思考。有更简单的方法吗？

ActiveSheet.Range("$A$1:$E$175").AutoFilter Field:=4, Criteria1:= _
"DEPARTMENT NAME"
'Selects first visible row of filtered data set & _
create array that contains all filtered names  
ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(3, 2).Select
employeerange = "C" & ActiveCell.Row & ":C" & ActiveSheet.Rows.Count
Dim employeearray As Variant
employeearray = Range(employeerange).Value
'Cycle through all possible items for the given Pivot Field and compare to _ 
each of the names in the employee array.  Set items that match to visible _ 
and all others to hidden.
Dim PI As PivotItem
Dim element As Variant
With ActiveSheet.PivotTables("PivotTable2").PivotFields("PIVOT FIELD")
For Each PI In .PivotItems
For Each element In employeearray
If PI Like "*" & CStr(element) & "*" Then
PI.Visible = True
Else
PI.Visible = False
End If
Next element
Next PI
End With

Answer 1

在对数据透视项进行迭代时，需要避免一些瓶颈和问题。查看我的帖子http://dailydoseofexcel.com/archives/2013/11/14/filtering-pivots-based-on-external-ranges/了解更多信息。

除其他外，您希望在执行迭代时将数据透视表的ManualUpdate属性设置为TRUE，然后在执行迭代后返回FALSE。否则，每次更改数据透视项的可见性时，Excel都会尝试更新数据透视表。您还需要确保至少有一个项目始终可见。我用这样的东西：

Option Explicit
Sub FilterPivot()
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim i As Long
Dim vItem As Variant
Dim vCountries As Variant
Set pt = ActiveSheet.PivotTables("PivotTable1")
Set pf = pt.PivotFields("CountryName")
vCountries = Array("FRANCE", "BELGIUM", "LUXEMBOURG")
pt.ManualUpdate = True 'Stops PivotTable from refreshing after each PivotItem is changed
With pf
'At least one item must remain visible in the PivotTable at all times, so make the first
'item visible, and at the end of the routine, check if it actually  *should* be visible        
.PivotItems(1).Visible = True
'Hide any other items that aren't already hidden.
'Note that it is far quicker to check the status than to change it.
' So only hide each item if it isn't already hidden
For i = 2 To .PivotItems.Count
If .PivotItems(i).Visible Then .PivotItems(i).Visible = False
Next i
'Make the PivotItems of interest visible
On Error Resume Next 'In case one of the items isn't found
For Each vItem In vCountries
.PivotItems(vItem).Visible = True
Next vItem
On Error GoTo 0
'Hide the first PivotItem, unless it is one of the countries of interest
On Error Resume Next
If InStr(UCase(Join(vCountries, "|")), UCase(.PivotItems(1))) = 0 Then .PivotItems(1).Visible = False
If Err.Number <> 0 Then
.ClearAllFilters
MsgBox Title:="No Items Found", Prompt:="None of the desired items was found in the Pivot, so I have cleared the filter"
End If
On Error GoTo 0
End With
pt.ManualUpdate = False
End Sub

Answer 2

您是否检查了构建数组的代码的第一部分？我看不到你的数据，但我不确定这是否会像你希望的那样奏效。

要建立您的阵列，请使用以下内容：

ActiveSheet.Range("$A$1:$E$175").AutoFilter Field:=4, Criteria1:= "DEPARTMENT NAME"
Dim employeearray As Variant
employeearray = ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Columns("C").Value

至于宏的第二部分。。

你过度测试了比赛，如果你让它继续运行，除了最后一场比赛之外，其他一切都会被隐藏起来。

请改用以下方法，该方法将遍历所有.ProtvoItems，但使用单个测试来检查该项是否在数组中。

Dim PI As PivotItem
With ActiveSheet.PivotTables("PivotTable2").PivotFields("PIVOT FIELD")
For Each PI In .PivotItems
PI.Visible = (UBound(Filter(employeearray, PI.Name)) > -1)
Next PI
End With