Question

我希望有人可以提供帮助。我有一个由其他人创建的仪表板，其中有多个表格，所有表格都是从表格1中的下拉日期选择（从 - 到）开始操作。我被要求添加到此，并创建了最适合的数据透视表工作。我遇到的问题是我需要它们根据表1中的下拉日期进行过滤。

我希望通过VBA实现这一目标。

我已经能够根据另一个基于文本的下拉列表来过滤我的数据透视报告。但是无法获得相同的代码（当调整为专注于“月”选项和关联的下拉单元格）以进行日期选择时，我也无法弄清楚如何允许多个选择以便我可以选择日期范围。

我一直使用的代码如下：

Private Sub Worksheet_Change(ByVal Target As Range)

Dim ws As Worksheet
Dim pt As PivotTable
Dim pi As PivotItem
Dim strField As String

strField = "Region"

On Error Resume Next
Application.EnableEvents = False
Application.ScreenUpdating = False

If Target.Address = Range("D2").Address Then

    For Each ws In ThisWorkbook.Worksheets
        For Each pt In ws.PivotTables
            With pt.PageFields(strField)
                For Each pi In .PivotItems
                    If pi.Value = Target.Value Then
                        .CurrentPage = Target.Value
                        Exit For
                    Else
                        .CurrentPage = "(All)"
                    End If
                Next pi
            End With
        Next pt
    Next ws

End If

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

任何人都能提供的帮助将非常感激。我是VBA的新手，并尽我所能调整我在网上找到的代码但是很挣扎。

由于

修订：我还尝试了以下在其他地方找到的用于选择日期范围的代码

Sub FilterPivotDates()
'
Dim dStart As Date
Dim dEnd As Date
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem

Application.ScreenUpdating = False
On Error Resume Next

dStart = Sheets("Pivots").Range("F2").Value
dEnd = Sheets("Pivots").Range("f3").Value

Set pt = ActiveSheet.PivotTable1
Set pf = pt.PivotFields("Month")

pt.ManualUpdate = True

pf.EnableMultiplePageItems = True

For Each pi In pf.PivotItems
  pi.Visible = True
Next pi

For Each pi In pf.PivotItems
 If pi.Value < dStart Or pi.Value > dEnd Then
pi.Visible = False
End If
Next pi

Application.ScreenUpdating = False
pt.ManualUpdate = False

Set pf = Nothing
Set pt = Nothing

End Sub

在示例中，我发现这是由一个按钮操作，但我只是在工作表中尝试过。但这对我也不起作用。

Answer 1

以下是一些建议。

您有哪个版本的Excel？如果使用Excel 2010或更高版本，您可以简单地回避问题，因为您只需在日期字段上设置切片器，然后将切片器连接到要同步的任何数据透视表。在以后的版本中，您可以使用称为时间轴的专用切片器执行相同的操作。我在一段时间后在以下链接上写了一篇相关帖子，可能会引起关注： http://dailydoseofexcel.com/archives/2014/08/16/sync-pivots-from-dropdown/
根据IronyAaron在this thread的评论中所说：

当VBA识别出透视缓存中的日期时，它会读取美国解析后的版本虽然该项目被读取为本地格式串。因此，这会在识别日期时导致VBA失败变量。

这可能是你的问题。我最近经历了一些类似的问题并通过将我希望过滤数据透视表的日期转换为DateSerial（以绕过美国与非美国日期和不兼容性＆＃39;）然后将该DateSerial转换为很长，使用以下代码行：

CLng（DateSerial（Year（vItem），Month（vItem），Day（vItem）））

您的代码可能需要这样的内容。如果您修改问题以包含不是工作的确切代码，那么我将会看一下。

查看我最近提出的这个问题：我可以很容易地修改它来做你想做的事情。 Filtering pivot table with vba

<强> --- ---编辑

在日期范围内以编程方式过滤pivot的最有效方法是利用内置的 Date Between 功能，即：

唯一的问题是，根据以下屏幕截图，PageFields（即拖动到“过滤器”窗格的字段）无法使用此功能：

因此，如果您想使用以下代码，则必须将Month字段作为RowField拖动到数据透视表中，如下所示：

假设不会出现任何问题，那么您可以使用以下代码：

Private Sub Worksheet_Change(ByVal Target As Range)

Dim pt As PivotTable
Dim vItem As Variant
Dim rFrom As Range
Dim rTo As Range

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

Set rFrom = Range("dvFrom")
Set rTo = Range("dvTo")

If Not Intersect(Target, rFrom) Is Nothing Or Not Intersect(Target, rTo) Is Nothing Then
    If rFrom < rTo Then
        For Each vItem In Array("PivotTable1", "PivotTable2") 'Change PivotTable names as appropriate
            Set pt = Sheet1.PivotTables(vItem) 'Change Sheet as appropriate
            With pt.PivotFields("Month")
                .ClearAllFilters
                .PivotFilters.Add2 _
                    Type:=xlDateBetween, _
                    Value1:=CLng(DateSerial(Year(rFrom), Month(rFrom), Day(rFrom))), _
                    Value2:=CLng(DateSerial(Year(rTo), Month(rTo), Day(rTo)))
                    'I use "CLng(DateSerial" because otherwise VBA may get confused
                    ' if the user's Excel i set to a non US dateformat.
            End With
        Next vItem
    End If
End If

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

请注意，我已将名称dvFrom和dvTo分配给您的数据验证下拉列表，然后在代码中引用这些名称。您必须在主表中执行相同的操作。

如果您不想更改数据透视表布局，则解决方法是在月份字段上添加TimeLine，并通过下拉菜单以编程方式更改。然后它将更新数据透视表。这是看起来的样子：

请注意，“月”字段看起来并没有应用过滤器，但它确实......显示在数据透视表中的总数中。

以下是时间轴驱动版本的修改代码：

Private Sub Worksheet_Change(ByVal Target As Range)

Dim vItem As Variant
Dim rFrom As Range
Dim rTo As Range
Dim lFrom As Long
Dim lTo As Long
Dim dte As Date

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

Set rFrom = Range("dvFrom")
Set rTo = Range("dvTo")

If Not Intersect(Target, rFrom) Is Nothing Or Not Intersect(Target, rTo) Is Nothing Then
    lFrom = CLng(DateSerial(Year(rFrom), Month(rFrom), Day(rFrom)))
    lTo = CLng(DateSerial(Year(rTo), Month(rTo), Day(rTo)))
    If lFrom < lTo Then
        For Each vItem In Array("NativeTimeline_Month", "NativeTimeline_Month1") 'Adjust timeline names as neccessary
            ActiveWorkbook.SlicerCaches(vItem).TimelineState. _
                SetFilterDateRange lFrom, lTo
        Next vItem
    End If
End If


With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With


End Sub

这让我们得到了你原来的方法 - 遍历PivotItems。事实证明，这不仅效率极低，而且还要求您暂时将月份字段的数字格式从MMM-YY格式更改为DD-MM-YY格式或类似格式，否则VBA可能会误将年份误解为一天，然后使用当年作为年份。因此，如果您的PivotItem是OCT-15，那么VBA会将其解释为2016年10月15日（我输入的当前年份），而不是2015年10月1日。讨厌。

因此我建议转向清除迭代，并更改数据透视表格式并使用我的第一种方法，或添加TimeLine并使用我的第二种方法。

使用VBA根据下拉选项过滤多个数据透视表

1 个答案: