选择与其他Excel工作表中的项目列表匹配的所有透视项目

我有一张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

---

您是否检查了构建阵列的代码的第一部分？我看不到您的数据，但我不确定这是否会按您希望的方式工作

要构建阵列，请使用以下方法：

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

至于宏的第二部分

你对比赛进行了过度测试，如果你让它继续运行，它将隐藏除最后一场比赛之外的所有内容

改为使用以下方法，该方法循环遍历所有.PivotItems，但使用单个测试检查该项是否在数组中

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

---

在对数据透视项进行迭代时，存在两个您希望避免的瓶颈和陷阱。更多信息，请参阅我的帖子

除此之外，您还希望在执行迭代时将数据透视表的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

---

谢谢Jeffrey，我能让这个代码正常工作！我在描述中遗漏的一个关键点是，数组将有一个名称列表，但透视表中的项可能与该列表不完全匹配，即可能会在后面添加一个中间首字母。有没有办法修改这段代码，以便在透视表中查找类似的项，比如我在原始代码中使用的PI？嗨，Katharine。很高兴这篇文章有帮助。请将答案标记为有用，如果它解决了问题，也请接受它。关于你的问题，这基本上就是所谓的模糊匹配，计算成本非常高，编码起来非常棘手。我已经在一个商业应用程序上工作了好几年，几乎准备发布它，但我担心这是一个付费产品。感谢CLR的推荐！当我尝试这样做时，我得到了一个不匹配错误，即使代码显示PI.Visible被设置为true。这可能是因为该项最初设置为true吗？我添加了Jeffrey的代码，用于在建议中的for循环之前将所有透视项的可见性设置为false。我执行此操作时，代码会运行，但它会使所有项都不可见，即使我知道应该有匹配项。数组中的值可能与透视表中的值略有不同，即它们可能缺少中间的首字母。我的理解是filter函数将返回数组中的项，即使它不是一个精确匹配，就像我的情况一样。在我的示例中，如果employeearray中的任何项在其文本中包含PI.Name，VBA中的Filter函数将生成一个包含匹配项的数组。因此，如果其中一个employeearray项包含JOHN H SMITH和PI。名称为JOHN SMITH，则它将不匹配。事实上，只有非常复杂的方法可以尝试这种匹配，比如模糊搜索。如果PI.Name是JOHN或SMITH，它将匹配，正如在JOHN SMITH中找到的那样。另一个选项是创建一个转换数组/表，允许JOHN H SMITH转换为JOHN*SMITH，例如，以便JOHN H SMITH或JOHN SMITH匹配它。