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

Posted 2023-03-10

【中文标题】使用 VBA 根据下拉选择过滤多个数据透视表

【英文标题】：Filtering multiple pivot tables based on drop down selections using VBA

【发布时间】：2016-12-30 13:27:27

【问题描述】：

我希望有人可以提供帮助。我有一个由其他人创建的仪表板，其中跨表有许多表，所有表都从表 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

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

【问题讨论】：

您的“月份”实际上是从日期中获取的，格式为 dd/mm/yyyy 或类似的格式吗？

是的，我的源数据将我的月份作为日期格式为 mmm yy，并且我的月份下拉选择是相同的。该代码在查找基于文本的信息时工作得非常好，但不会查找日期

请同时发布不起作用的代码。

【参考方案1】：

这里有几个建议。

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

根据this thread cmets 中 IronyAaron 的说法：

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

这可能是你的问题。我最近遇到了一些类似的问题，并通过将我想要过滤 Pivot 的日期转换为 DateSerial （以解决美国与非美国日期“不兼容性”）然后将该 DateSerial 转换为 Long 来解决它，如下所示代码行：

CLng(DateSerial(Year(vItem), Month(vItem), Day(vItem)))

您的代码可能需要这样的东西。如果您修改您的问题以包含不起作用的确切代码，那么我会看看。

查看我最近回答的这个 SO 问题：它可能很容易修改为您想要的。 Filtering pivot table with vba

---编辑---

在日期范围内以编程方式过滤枢轴的最有效方法是利用内置的 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 分配给您的数据验证下拉菜单，然后在代码中引用了这些名称。您必须在主表中执行相同操作。

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

请注意，Month 字段看起来并没有应用过滤器，但它确实......正如数据透视表中显示的总计所证明的那样。

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

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 日。讨厌。

所以我建议不要进行迭代，要么更改数据透视表格式并使用我的第一种方法，要么添加一个时间线并使用我的第二种方法。

【讨论】：

您使用的是什么版本的 Excel？

您好杰瑞，感谢您的回复。我不起作用的代码与上面完全相同，但是将“Region”替换为“Month”，将“D5”替换为“D3”——使用它时什么都没有发生。我正在使用 excel 2016，但遗憾的是切片器不是一个选项，因为最终用户希望使用工作表 1 上的两个下拉框从日期范围选择中操作所有内容（其他普通表也是仪表板的一部分，我没有创建原始文件）。我觉得日期有问题，但我应该在哪里添加您建议的代码？

我也尝试过构建启用多项选择功能，但我现在再次确定如何做到这一点

你能发布一个示例文件的链接吗？否则很难排除故障。随意剥离任何机密内容。

关于切片器，它们的重点是将所有数据透视图中的所有日期字段连接在一起，这样如果其中一个发生更改，它们都会更改以显示没有VBA也一样。根据我在上面第 1 点中链接到的那篇文章，您可以通过制作数据透视表的副本来“伪造”下拉列表，并从中删除除您想要下拉列表的字段之外的所有字段。然后将该字段移动到“过滤器”窗格。看起来就像一个下拉列表，但有细微的差别：更改它，任何其他与切片器连接的数据透视表也会更改。很简单。