Question

我有一张Excel工作表，其中包含人员及其相关部门的列表。在另一张工作表上的数据透视表中，我想过滤结果，以便显示“分配给”给定部门中任何人员的所有项目。

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

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

您是否检查了构建数组的代码的第一部分？我看不到您的数据，但不确定是否可以按照您希望的方式使用。

要构建阵列，请使用类似以下内容的

：

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

Answer 2

在PivotItems上进行迭代时，您要避免几个瓶颈和陷阱。有关更多信息，请参见我在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

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

2 个答案: