使用VBA根据下拉选择筛选多个数据透视表 [英] Filtering multiple pivot tables based on drop down selections using VBA

问题描述

我希望有人能提供帮助.我有一个由其他人创建的仪表板，该表上有许多工作表，所有工作表均从工作表1上的下拉日期选择(从-到)进行操作.我被要求添加此信息，并创建了最适合的数据透视表工作.我的问题是我需要它们根据工作表1上的下拉日期进行过滤.

I'm hoping someone can help. I have a dashboard created by someone else where there are numerous tables across sheets all operating from drop down date selections (From - To) on sheet 1. I have been asked to add to this, and have created pivot tables that are most suitable to the work. The problem I have is that I need them to filter based on the drop down dates on sheet 1.

我希望可以通过VBA做到这一点.

I am hoping this is possible via VBA.

我已经能够使我的数据透视报告基于另一个基于文本的下拉列表进行过滤.但是无法获得相同的代码(当调整为专注于月"选项和相关的下拉单元格时)才能用于日期选择，而且我也无法弄清楚如何允许多个选择以便选择日期范围.

I have been able to get my pivot reports to filter based on another drop down which is text based. But cannot get the same code (when tweaked to focus on the "month" option and associated drop down cell) to work for a date selection, and I also cannot figure out how to allow multiple selections so that I can choose the date range.

我一直在使用的代码如下:

The code I have been using is as follows:

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还是很陌生，我会尽力调整我在网上发现但很挣扎的代码.

Any help anyone is able to provide would be much appreciated. I'm fairly new to VBA and trying my best to tweak code I am finding online but struggling.

谢谢

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

Revised: I also tried the below code that I found elsewhere which was being used for selecting date ranges

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

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

In the example I found this was being operated by a button but I just tried it in the sheet. But this also does not work for me.

推荐答案

以下是一些建议.

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

1. What version of Excel do you have? You may be able to simply sidestep the issue if using Excel 2010 or later, because you can simply set up a Slicer on the date field, and then connect that Slicer to any PivotTables that you want to sync. In later versions you can do the same using a specialised slicer called a Timeline. I wrote a related post on this some time back at the following link that might be of interest: http://dailydoseofexcel.com/archives/2014/08/16/sync-pivots-from-dropdown/

根据IronyAaron在

According to IronyAaron in the comments at this thread:

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

When VBA recognizes the dates in the pivot cache, it reads the US version after parsing although the item is read as a locally formatted string. This therefore causes VBA to fail when recognizing Date variables.

这可能是您的问题.我最近遇到了一些类似的问题，并通过将要过滤数据透视表的日期转换为DateSerial来解决(以避开美国日期与非美国日期的不兼容性")，然后将该DateSerial转换为Long，并执行以下操作代码行:

That might be your issue. I recently experienced some similar issues and got around it by converting the date I wanted to filter the Pivot on to a DateSerial (to get around US vs Non-US date 'incompatibilities') and then cast that DateSerial as a Long, with the following line of code:

CLng(DateSerial(年(vItem)，月(vItem)，天(vItem)))

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

您的代码可能需要这样的内容.如果您要修改问题以包含无效的确切代码，那么我来看看.

Your code may need something like this. If you amend your question to include the exact code that isn't working then I'll take a look.

1. 查看我最近回答的这个问题:可以很容易地将其修改为您要执行的操作. 使用vba过滤数据透视表

1. Check out this recent SO question I answered: It might be easily amended to do what you want. Filtering pivot table with vba

---编辑---

以编程方式在日期范围内过滤数据透视表的最有效方法是利用内置的 Date Between 功能，即:

The most efficient way to filter pivots programmatically on a date range is to leverage the inbuilt Date Between functionality, i.e. this thing:

唯一的问题是，根据以下屏幕截图，此功能不适用于PageFields(即，将字段拖到过滤器"窗格中):

The only problem is that this functionality isn't available to PageFields (i.e. fields dragged to the Filters pane) as per the following screenshot:

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

So if you want to use the following code, you'll have to drag your Month fields into the PivotTable as a RowField, like so:

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

Assuming that's not going to present any issues, then you can use the following code:

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，然后在代码中引用了这些名称.您必须在母版工作表中执行相同的操作.

Note that I've assigned the names dvFrom and dvTo to your data validation dropdowns, and then referenced those names in the code. You'll have to do the same in your master sheet.

如果您不想更改数据透视表的布局，则一种解决方法是在月"字段中添加时间线，并通过下拉菜单以编程方式对其进行更改.然后它将更新数据透视表.外观如下:

If you don't want to change your PivotTable layout, then a workaround is to add a TimeLine on the month field, and programmatically change that via the dropdowns. It will then update the PivotTable. Here's how that looks:

请注意，月份"字段看起来好像没有应用过滤器，但确实...如数据透视表中显示的总数所证明.

Note that the Month field doesn't look like it has a filter applied, but it does...as evidenced by the totals that display in the PivotTable.

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

Here's the modified code for the Timeline-driven version:

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可能会将Year误解为一天，然后使用当前年份作为年份.因此，如果您的PivotItem是OCT-15，则VBA会将其解释为2016年10月15日(即我键入的当年年份)，而不是2015年10月1日.讨厌.

And that leaves us with your original approach - iterating through the PivotItems. It turns out that this is not just horribly inefficient, but also requires you temporarily to change your number format of the Month field from a MMM-YY format to a DD-MM-YY format or similar, because otherwise VBA might misinterpret the Year as a day, and then use the current year as the year. So if your PivotItem is OCT-15 then VBA interprets that as 15 October 2016 (the current year as I type this) instead of 1 October 2015. Nasty.

因此，我建议您避免迭代，并更改数据透视表格式并使用我的第一种方法，或者添加时间线并使用我的第二种方法.

So I'd advise steering clear of iteration, and either change your PivotTable format and use my first approach, or add a TimeLine and use my second approach.

这篇关于使用VBA根据下拉选择筛选多个数据透视表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！