使用2个单元格中的日期范围和另一个单元格中的名称来更新数据透视表过滤器

时间:2019-05-09 08:43:54

标签: excel vba pivot-table

我有一个Excel仪表板,可以在特定单元格中更改名称和日期时更新表和图表,但是我还需要2个数据透视表才能使用这些单元格进行更新。 我的名字单元格是D2:G2,我的日期范围单元格是从:P2到:R2

我已经尝试了在网络上找到的各种解决方案来更新日期范围,但是当尝试将它们与名称更新代码链接时,它们都不起作用。

到目前为止,我有:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim PTable As PivotTable
    Dim PField As PivotField
    Dim Str As String

    On Error Resume Next
    If Intersect(Target, Range("D2:G2")) Is Nothing Then Exit Sub

    Application.ScreenUpdating = False
    Set PTable = Worksheets("Stats").PivotTables("PivotTable1")
    Set PField = PTable.PivotFields("BM attendees")
    Str = Target.Text
    PField.ClearAllFilters
    PField.CurrentPage = Str
    Application.ScreenUpdating = True
End Sub

我有一些可以工作的VBA,可以在更改名称时更新其中一个枢轴,但是我需要两个枢轴都进行更新,并且还需要根据日期范围来更新两个枢轴上的日期。 如果有人可以帮助VBA进行这项工作,将不胜感激。

1 个答案:

答案 0 :(得分:0)

这里是一个1个数据透视表的示例,以演示如何在数据透视表的过滤器(= PageFields)中选择数据透视表。由于您无法在页面字段上设置日期范围,因此需要将每个相应的枢轴项目切换为可见或不可见。

您始终必须确保至少有一个枢轴项目仍然可见。

在尝试将当前页面切换到该与会者之前,还必须确保给定的与会者名称(在Target.Text中)与任何透视表项相对应。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim PTable As PivotTable
    Dim PField As PivotField
    Dim PItem As PivotItem
    Dim AttendeeName As Range
    Dim DateFrom As Range, DateTo As Range
    Dim AtLeastItemRemainsVisible As Boolean

    Set AttendeeName = ActiveSheet.Range("D2")
    Set DateFrom = ActiveSheet.Range("D2")
    Set DateTo = ActiveSheet.Range("R2")

    Set PTable = Worksheets("Stats").PivotTables(1) ' or ("PivotTable1")

    Application.ScreenUpdating = False
    'Application.EnableEvents = False

    ' Select 1 attendee name as single filter page:
    If Not Intersect(Target, AttendeeName) Is Nothing Then
        Set PField = PTable.PageFields(1) ' or ("BM attendees")
        PField.ClearAllFilters
        PField.EnableMultiplePageItems = False
        For Each PItem In PField.PivotItems
            If PItem.Name = Target.Text Then
                PField.CurrentPage = Target.Text
            End If
        Next PItem

    ' select all valid dates between two given dates:
    ElseIf Not Intersect(Target, Union(DateFrom, DateTo)) Is Nothing Then
        Set PField = PTable.PageFields(2)
        PField.ClearAllFilters
        PField.EnableMultiplePageItems = True

        ' at least 1 PivotItem must remain visible:
        AtLeastItemRemainsVisible = False
        For Each PItem In PField.PivotItems
            If CDate(PItem.Name) >= CDate(DateFrom) _
                And CDate(PItem.Name) <= CDate(DateTo) Then
                AtLeastItemRemainsVisible = True
                Exit For
            End If
        Next PItem

        If AtLeastItemRemainsVisible Then
            For Each PItem In PField.PivotItems
                PItem.Visible = _
                    CDate(PItem.Name) >= CDate(DateFrom) _
                    And CDate(PItem.Name) <= CDate(DateTo)
            Next PItem
        End If
    End If

    'Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

单独的故事:我建议在相应的行字段或列字段上使用日期过滤器,而不要使用日期作为PageField。请注意,必须将日期值转换为字符串才能与PivotFilter一起使用。这是一个一般示例:

Private Sub DateFilter()
    With ActiveSheet.PivotTables(1).RowFields(1)
        .ClearAllFilters

        ' between two dates:
        .PivotFilters.Add2 _
            Type:=xlDateBetween, _
            Value1:=CStr(DateSerial(Year(Date) - 1, Month(Date), Day(Date))), _
            Value2:=CStr(Date), _
            WholeDayFilter:=True

        ' another example, please refer to macro recorder for special date ranges:
        .PivotFilters.Add2 _
            Type:=xlDateThisYear

    End With
End Sub