ExcelVBA在通过报表过滤器循环时优化速度-ExcelVBAoptimizespeedwhenloopingthroughreportfilter

Final Solution Edit:

Firstly, I apologize this took so long. Shortly after writing this I went out of town and was then pulled off this project until I was able to find time to work on it recently.

首先，我道歉这花了这么长时间。写完这篇文章后不久，我就出了城，然后被拉下了这个项目，直到最近我有时间去做它。

Jerry gave me the great idea of using groups on row labels rather than attempting to filter the dates one at a time. With some modification I was able to get this to work for my needs and at a much faster rate. At its slowest, I have trimmed the time down from up to 5+ minutes to 45 seconds, and there are still optimizations I would like to make over time. This is an excellent method that allows me to update several related pivot tables.

Jerry让我想到了在行标签上使用组，而不是每次过滤一个日期。通过一些修改，我能够使它以更快的速度满足我的需要。在最慢的时候，我将时间从5分多钟减少到45秒，而且随着时间的推移，我仍然希望进行一些优化。这是一个很好的方法，它允许我更新几个相关的数据透视表。

The code for those of you that might find it useful - mind it includes a great deal extra:

你们可能会发现它有用的代码——注意它包含了很多额外的东西:

Sub Filter_PivotField_by_Dates(TargetPvtFld As PivotField, dtFrom As Date, dtTo As Date, _
                            Optional dtFrom2 As Date, Optional dtTo2 As Date)
' Filter the dates on all related pivoted tables via a grouping method.

' Variables -----
Dim bMultiRng As Boolean
Dim iPvtTblRowCnt As Integer, iPvtTblColCnt As Integer, i As Integer, j As Integer, iGrpTrack As Integer, iSlcRowCnt As Integer
Dim sarrPvtInfo() As String, sarrSlcInfo() As String
Dim xCell As Range, rngGroup As Range, LastRw As Range, LastCol As Range
Dim PvtFld As PivotField
Dim Pvt As PivotTable
Dim SlcItm As SlicerItem
Dim SlcCache As SlicerCache
Dim WS As Worksheet
' ---------------

' Disable application updating for speed.
With Application
    .EnableEvents = False
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With

' First validate and determine whether or not it will be necessary to create a secondary comparison group.
' Ensure that something valid is entered for the pivot field value.
If TargetPvtFld Is Nothing Then
    Msgbox "Invalid pivot field supplied to filter by date macro."
    Exit Sub
Else
    On Error Resume Next
    Debug.Print "Target Pvt Field Name: " & TargetPvtFld.Name
    If Err.Number > 0 Then
        Debug.Print "Invalid pivot field supplied as target pivot field."
        Debug.Print " ----------------------------------"
        Err.Clear
        Exit Sub
    End If
    On Error GoTo 0
End If

If dtFrom <= 0 Or dtTo <= 0 Then
    Debug.Print "Invalid dates fed to Filter Pivot by Date macro."
    Exit Sub
ElseIf dtFrom > dtTo Then
    MsgBox "Please ensure that the starting date of comparison range 1 comes prior or equal to the ending date."
    Exit Sub
End If

If dtFrom2 <= 0 Or dtTo2 <= 0 Then bMultiRng = False Else bMultiRng = True

' If there is a comparison date range fed, then validate.
If bMultiRng Then
    If dtFrom2 > dtTo2 Then
        MsgBox "Please ensure that the starting date of comparison range 2 comes prior or equal to the ending date."
        Exit Sub
    ElseIf (dtFrom2 >= dtFrom And dtFrom2 <= dtTo) Or (dtTo2 >= dtFrom And dtFrom2 <= dtTo) Then
        MsgBox "Please ensure that the two comparison dates are not overlapping before continuing."
        Exit Sub
    End If
End If

' Determine how many pivot tables are related to the target for tracking original row field variables.
' Define the first dimension on the multidimensional tracking array. Hate looping twice, figure out a better way later!
For Each WS In ActiveWorkbook.Worksheets
    For Each Pvt In WS.PivotTables
        If Pvt.CacheIndex = TargetPvtFld.Parent.CacheIndex Then
            ' Record the number of pivot tables.
            iPvtTblRowCnt = iPvtTblRowCnt + 1
            i = 0
            ' Loop through and determine the number of maximum fields.
            For Each PvtFld In Pvt.PivotFields
                If PvtFld.Orientation = xlRowField Then
                    i = i + 1
                    If i > iPvtTblColCnt Then iPvtTblColCnt = i
                End If
            Next PvtFld
        End If
    Next Pvt
Next WS

' Dimension full size of multidimensional array to store info about current state of linked pivot tables.
    ' The first field will contain each pivot tables name. The second field will contain the name of each pivot table field that
    ' is currently a row field for restoration after the event date filtering.
ReDim sarrPvtInfo(0 To iPvtTblRowCnt, 0 To iPvtTblColCnt)

' Reset increment counters.
i = 0
j = 0

' Loop one more time through each pivot cache and record each related pivot table's name and it's respective
' pivot field names in the array for future use.
For Each WS In ActiveWorkbook.Worksheets
    For Each Pvt In WS.PivotTables
        If Pvt.CacheIndex = TargetPvtFld.Parent.CacheIndex Then
            sarrPvtInfo(i, 0) = Pvt.Name
            j = 1
            For Each PvtFld In Pvt.PivotFields
                If PvtFld.Parent.Name = TargetPvtFld.Parent.Name Then
                    If PvtFld.Orientation = xlRowField Then
                        sarrPvtInfo(i, j) = PvtFld.Name
                        j = j + 1
                        ' Now remove the field after storing it. It will be returned after the date change.
                        PvtFld.Orientation = xlHidden
                    Else
                        If PvtFld.Name <> "Values" Then
                        End If
                    End If
                End If
                ' Remove all column labels (except values) to ensure proper ungrouping.
                If PvtFld.Orientation = xlColumnField And PvtFld.Name <> "Values" Then
                    PvtFld.Orientation = xlHidden
                End If
            Next PvtFld
        i = i + 1
        End If
    Next Pvt
Next WS

' In order to filter, there cannot be any filters on the data from the slicers.
' First identify the target pivot field's slicer caches.
i = 0
iSlcRowCnt = 0
For Each SlcCache In ActiveWorkbook.SlicerCaches
    For Each Pvt In SlcCache.PivotTables
        If Pvt = TargetPvtFld.Parent And Not SlcCache.Name Like "*event_date*" Then
        Debug.Print " -----" & vbNewLine & SlcCache.Name & vbNewLine & " ----- "
        Debug.Print Pvt.Name
            If i > iSlcRowCnt Then iSlcRowCnt = i
            i = i + 1
        End If
    Next Pvt
Next SlcCache

' Size the array based off of our values.
ReDim sarrSlcInfo(0 To iSlcRowCnt, 0 To 0)

' Reset the increment counters - again.
i = 0
j = 0

' Now loop through all the slicer caches and find which cache has slicers related to the pivot table. If
' those slicers have disabled items, record them and, after all are recorded, remove the filter to prevent
' issues during the date grouping process.
For Each SlcCache In ActiveWorkbook.SlicerCaches
    For Each Pvt In SlcCache.PivotTables
        If Pvt = TargetPvtFld.Parent And Not SlcCache.Name Like "*event_date*" Then
            sarrSlcInfo(i, 0) = SlcCache.Name
            j = 1
            For Each SlcItm In SlcCache.SlicerItems
                If Not SlcItm.Selected Then
                    ReDim Preserve sarrSlcInfo(0 To UBound(sarrSlcInfo, 1), j)
                    sarrSlcInfo(i, j) = SlcItm.Name
                    j = j + 1
                End If
            Next SlcItm
            SlcCache.ClearManualFilter
            i = i + 1
        End If
    Next Pvt
Next SlcCache

' Now begin to actually filter the dates.
With TargetPvtFld
    .Orientation = xlRowField
    .ClearAllFilters

    ' This dynamically removes all grouped Event_Date fields prior to the grouping to come.
    ' This only needs to be performed on a single pivot, other related pivots will have the grouped
    ' fields removed as well via the cache.
    For Each PvtFld In .Parent.PivotFields
        If PvtFld.Name Like .Name & "?" Then
            PvtFld.Orientation = xlRowField
            PvtFld.Position = 1
            PvtFld.ClearAllFilters
            iGrpTrack = iGrpTrack + 1
        End If
    Next PvtFld
    i = 0
    Do Until i >= iGrpTrack
        If iGrpTrack = 0 Then Exit Do
        .DataRange.Cells.Ungroup
        i = i + 1
    Loop
End With

' Now create the two groups as necessary with a third "Other" group to exclude.
' Comparison Group #1 *-----
' Loop through all cells in the date's data range and add all those that match the first criteria to a range for grouping.
For Each xCell In TargetPvtFld.DataRange.Cells
    If xCell.Value >= dtFrom And xCell.Value <= dtTo Then
        'If this is the first encountered occurrence of a match, add it.
        If rngGroup Is Nothing Then
            Set rngGroup = xCell
        Else
            ' Otherwise, union it with the existing range.
            Set rngGroup = Union(rngGroup, xCell)
        End If
    End If
Next xCell

' Finally, group the range. By default the range will inherit the the name Group1.
rngGroup.Group

' Comparison Group #2 *------
If bMultiRng Then
    Set rngGroup = Nothing
    For Each xCell In TargetPvtFld.DataRange.Cells
        If xCell.Value >= dtFrom2 And xCell.Value <= dtTo2 Then
            If rngGroup Is Nothing Then
                Set rngGroup = xCell
            Else
                Set rngGroup = Union(rngGroup, xCell)
            End If
        End If
    Next xCell

    rngGroup.Group
End If

' Excluded events group  *------
Set rngGroup = Nothing
For Each xCell In TargetPvtFld.DataRange.Cells
    If bMultiRng Then
        If Not (xCell.Value >= dtFrom And xCell.Value <= dtTo) _
        And Not (xCell.Value >= dtFrom2 And xCell.Value <= dtTo2) _
        And Not xCell.Value Like "*-*" _
        And Not xCell.Value Like "Group*" Then
            If rngGroup Is Nothing Then
                Set rngGroup = xCell
            Else
                Set rngGroup = Union(rngGroup, xCell)
            End If
        End If
    Else
        If Not (xCell.Value >= dtFrom And xCell.Value <= dtTo) _
        And Not xCell.Value Like "*-*" _
        And Not xCell.Value Like "Group*" Then
            If rngGroup Is Nothing Then
                Set rngGroup = xCell
            Else
                Set rngGroup = Union(rngGroup, xCell)
            End If
        End If
    End If
Next xCell

rngGroup.Group

' Now that the grouping is complete, remove the target pivot field from the rows.
TargetPvtFld.Orientation = xlHidden

' Perform the final steps to restore the pivot tables.
    ' Loop through each pivot table and rename each grouped field. Doing this by targeting the group name in the field rather than searching
    ' a range prevents the need to move the pivot fields around currently.
For Each WS In ActiveWorkbook.Worksheets
    For Each Pvt In WS.PivotTables
        If Pvt.CacheIndex = TargetPvtFld.Parent.CacheIndex Then
             Pvt.PivotFields(TargetPvtFld.Name & "2").PivotItems("Group1").Value = dtFrom & " - " & dtTo
            ' Optionally rename comparison group 2 in each pivot table. After which rename the remaining fields to group "Other."
            If bMultiRng Then
                Pvt.PivotFields(TargetPvtFld.Name & "2").PivotItems("Group2").Value = dtFrom2 & " - " & dtTo2
                Pvt.PivotFields(TargetPvtFld.Name & "2").PivotItems("Group3").Value = "Other"
            Else
                Pvt.PivotFields(TargetPvtFld.Name & "2").PivotItems("Group2").Value = "Other"
            End If
            ' Now filter out the "Other" group of event dates so they don't appear.
            Pvt.PivotFields(TargetPvtFld.Name & "2").PivotItems("Other").Visible = False
            ' Now, its time to place the modified event date column as our headers and ensure proper sorting.
            With Pvt.PivotFields(TargetPvtFld.Name & "2")
                .Orientation = xlColumnField
                .Position = 1
                .PivotItems(dtFrom & " - " & dtTo).Position = 1
            End With
        End If
    Next Pvt
Next WS


' Finally, we're ready to restore the original row fields back to each pivot table.
' Reset again.
i = 0
j = 0

' Restore the target pivot field's row field segments.
For i = 0 To UBound(sarrPvtInfo, 1)
    If sarrPvtInfo(i, 0) = TargetPvtFld.Parent.Name Then
        For j = 1 To UBound(sarrPvtInfo, 2)
            If sarrPvtInfo(i, j) <> "" Then
                TargetPvtFld.Parent.PivotFields(sarrPvtInfo(i, j)).Orientation = xlRowField
            End If
        Next j
    End If
Next i

' Now restore the target pivot field's slicer filters.
' First, disable updating on the pivot table until completed.
TargetPvtFld.Parent.ManualUpdate = True

For i = 0 To UBound(sarrSlcInfo, 1)
    For j = 1 To UBound(sarrSlcInfo, 2)
        If sarrSlcInfo(i, j) <> "" Then
            ActiveWorkbook.SlicerCaches(sarrSlcInfo(i, 0)).SlicerItems(sarrSlcInfo(i, j)).Selected = False
        End If
    Next j
Next i

' Finally, we'll reset the print area.
For Each WS In ActiveWorkbook.Worksheets
    For Each Pvt In WS.PivotTables
        If Pvt.CacheIndex = TargetPvtFld.Parent.CacheIndex Then
            With WS
                .PageSetup.PrintArea = ""
                LastRow = .Cells.Find(What:="*", searchorder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
                LastCol = .Cells.Find(What:="% Sold", searchorder:=xlColumns, SearchDirection:=xlPrevious, LookIn:=xlValues).Column
                .PageSetup.PrintArea = .Range(.Cells(1, 1), .Cells(LastRow, LastCol)).Address
            End With
        End If
    Next Pvt
Next WS

' Once more reenable automatic updating.
TargetPvtFld.Parent.ManualUpdate = False

' Reeanble application updating.
With Application
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
End With

End Sub

终止子

I've been wracking my brain for days trying to figure this out so ANY help is GREATLY appreciated!

我绞尽脑汁想弄明白这一点已经好几天了，所以非常感谢大家的帮助!

My Problem:

I have a pivot table that has a date report filter declared that I loop through given some cell input in order to dynamically filter the data. I have the loop running correctly and filtering the data, however it can a huge amount of time to loop through the visible property for each item (up to 3.5 mins when going from the full item list to a smaller subset). I'm looking for ways to optimize this after looking extensively online (seriously, I've spent at least 6+ hours looking). Its clearly the Pivotitems.visible property that is taking so long (up to a second per item) can I can't seem to figure out a way to speed it up.

我有一个数据透视表，它有一个日期报表过滤器，声明我通过给定的单元格输入进行循环，以便动态地过滤数据。我可以正确地运行循环并对数据进行过滤，但是对于每个项目(从完整的项目列表到较小的子集)，循环遍历可见属性的时间会非常长(最多3.5分钟)。我正在寻找方法来优化这一点，在广泛的网上搜索(认真地，我已经花了至少6个小时的时间看)。显然Pivotitems。可见的属性花费了很长时间(每项最多一秒)我似乎无法找到加速的方法。

What I've Tried:

In my code (below) I have tried/done the following:

在我的代码(以下)中，我尝试过以下方法:

• Set Application settings to false

  设置应用程序设置为false

  With Application
      .ScreenUpdating = False
      .EnableEvents = False
      .DisplayAlerts = False
      .CalculatiOnMethod= xlManual
  End with
  

• Set the manual update field on the pivot item.

  在主项目上设置手动更新字段。

  With Pivottable("somepivottable").Pivotfields("thatonefield")
      .ManaulUpdate = True
  End with
  

  • This doesn't actually seem to work, as even with the application settings set to false and manual update set to true I still can clearly see the application pausing when setting the item to visible (roughly .5 to a full second per item that is having its visible state altered)
  • 实际上，这似乎不起作用，因为即使应用程序设置为false，手动更新设置为true，我仍然可以清楚地看到，当将项设置为可见时，应用程序仍然会暂停(大约每项的可视状态被更改为0.5到1秒)

• Tried to set the filter as a column on another pivot table (connected via slicer in the same cache) and set a label filter. Didn't think this would work.. it didn't.

  尝试将过滤器设置为另一个pivot表(通过同一缓存中的切片器连接)上的列，并设置一个标签过滤器。没想到这行得通。它没有。

• Tried to macro record the actual filter selection process on the pivot (which is nearly instantaneous). From what I got from that I attempted to explicitly declare each pivot item as true or false but this had the same turnaround time as my standard code.

  尝试在枢轴上宏记录实际的过滤器选择过程(几乎是瞬时的)。从这里我尝试显式地声明每个pivot项目为true或false，但这与我的标准代码具有相同的周转时间。

And that's where I'm at. I have no other ideas. My pivot table is actually created from a SAS dataset (flat file, not OLAP cube) so the data isn't physically in the workbook which is what I prefer since the data is nearing 800k rows and will continue to grow to possibly double the size. Since the SAS addin pulls the data directly into the pivot cache I can avoid data restraints.

这就是我想说的。我没有别的想法。我的pivot表实际上是由SAS数据集(平面文件，而不是OLAP多维数据集)创建的，所以数据不在工作簿上，这是我喜欢的，因为数据接近800k行，并且将继续增长到可能的两倍。由于SAS addin将数据直接提取到主缓存中，我可以避免数据限制。

My Code So Far:

This is still pretty crude since I'm still sorting out some of the fine points though I'm certainly open to other optimizations too. The code is called from a userform and is a modified copy of code that I found from here and modified to accept two contiguous date ranges.

这仍然是相当粗糙的，因为我仍然在整理一些好的点，尽管我当然也对其他优化开放。该代码是从userform中调用的，是我从这里找到的修改后的代码副本，并修改为接受两个连续的日期范围。

Public Function Filter_PivotField_by_Date_Range(pvtField As PivotField, _
        dtFrom As Date, dtTo As Date, Optional ByVal dtFrom2 As Date, Optional ByVal dtTo2 As Date)
    ' Got the original (very useful) function from:
        ' http://www.mrexcel.com/forum/excel-questions/669688-select-date-range-pivot-table-using-visual-basic-applications.html
    ' Modified to use two non-continguous date ranges for YoY analysis.
    ' Ex: 1/1/2014 - 1/30/2014 AND 1/2/2013 - 2/1/2013

    ' Variables -----
    Dim blSingleRange As Boolean, blFormLoaded As Boolean
    Dim bTemp As Boolean, bTemp2 As Boolean, i As Long, iFirst As Long
    Dim dtTemp As Date, sItem1 As String
    Dim PT As PivotTable
    Dim Sheet As Worksheet
    ' ---------------

    On Error Resume Next

    If dtFrom2 <= 0 Or dtTo2 <= 0 Then
        blSingleRange = True
    End If

    With pvtField
        For i = 1 To .PivotItems.Count
            dtTemp = .PivotItems(i)
            bTemp = (dtTemp >= dtFrom) And (dtTemp <= dtTo)
            If Not blSingleRange Then
                bTemp2 = (dtTemp >= dtFrom2) And (dtTemp <= dtTo2)
            End If
            If bTemp Or bTemp2 Then
                sItem1 = .PivotItems(i)
                Exit For
            End If
        Next i
        If sItem1 = "" Then
            MsgBox "No items are within the specified dates."
            Exit Function
        End If

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

       For Each Sheet In ActiveWorkbook.Sheets
            For Each PT In Sheet.PivotTables
                If PT.CacheIndex = .Parent.CacheIndex Then
                    PT.ManualUpdate = True
                End If
            Next PT
        Next Sheet

        If .Orientation = xlPageField Then .EnableMultiplePageItems = True

        blFormLoaded = UserformFunctions.IsUserFormLoaded("DateProgressForm")

        For i = 1 To .PivotItems.Count
            dtTemp = .PivotItems(i)
            If blSingleRange Then
                If .PivotItems(i).Visible <> ((dtTemp >= dtFrom) And (dtTemp <= dtTo)) Then
                    .PivotItems(i).Visible = Not .PivotItems(i).Visible
                End If
            Else
                If (((dtTemp >= dtFrom) And (dtTemp <= dtTo)) _
                    Or ((dtTemp >= dtFrom2) And (dtTemp <= dtTo2))) Then
                    If .PivotItems(i).Visible = False Then .PivotItems(i).Visible = True
                Else
                    If .PivotItems(i).Visible = True Then .PivotItems(i).Visible = False
                End If
            End If

            ' Update the progress userform.
            siPrctComp = Round((i / .PivotItems.Count) * 100, 2)
            If blFormLoaded Then
                UserformFunctions.Form_Progress (siPrctComp)
                DoEvents
            End If

        Next i

        ' Reset the manual update property of each connected pivot table.
        For Each Sheet In ActiveWorkbook.Sheets
             For Each PT In Sheet.PivotTables
                 If PT.CacheIndex = .Parent.CacheIndex And PT.ManualUpdate = True Then
                     PT.ManualUpdate = False
                 End If
             Next PT
        Next Sheet
    End With

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

End Function

I've not noticed any hit for updating the progress userform (just a progress bar since it takes so long, lets the user know that its actually working). If I can make it work faster by removing it I will but thus far, even with the DoEvents call, it takes just as long. I've also tried setting all pivot tables in the workbook to manualupdate=true and just the current one, no change.

我没有注意到更新progress userform的任何影响(只是一个进度条，因为它需要很长时间，让用户知道它实际上在工作)。如果我可以通过移除它来加快工作速度，但是到目前为止，即使是DoEvents调用，它也会花费同样长的时间。我还尝试将工作簿中的所有pivot表设置为manualupdate=true，只设置当前的数据，不进行更改。

One thing I have noticed is that when the code breaks (or I insert a breakpoint/step through) the manualupdate property sets back to false. I'm not sure if this is by design or if there is something particularly wrong with my workbook/pivot table.

我注意到的一件事是，当代码中断(或插入断点/步骤)时，manualupdate属性将返回false。我不确定这是设计出来的，还是我的工作簿/数据透视表出了什么问题。

I have also attempted to find a way to use an array to batch apply the visible property but it doesn't seem possible.

我还试图找到一种方法来使用数组来批量应用可见属性，但这似乎是不可能的。

Thank you for any help you might be able to offer, its GREATLY appreciated and if you need something from me please let me know.

Edits to answer some of the comments (thank you for responding everyone!)

• Firstly, and I apologize for forgetting to mention this but I am using Excel 2010 32 bit.
• 首先，我很抱歉忘记提到这一点，但是我使用的是excel2010 32位。

Here is an example of the code that I get when macro recording the report filter or slicer change. This works nearly instantly via Excel's convention, manual methods but no so much if mimicked (even with the speed improvements) via VBA. If this would work, I would write code to pull the event date range and rewrite a custom macro each time the data updated.

下面是我在宏记录报表过滤器或切片器更改时得到的代码示例。这几乎可以通过Excel的约定、手动方法立即完成，但如果通过VBA进行模拟(即使速度有所提高)，就不会有这么多了。如果可以，我将编写代码来提取事件日期范围，并在每次数据更新时重写自定义宏。

Sub Macro1()
'
' Macro1 Macro
'

    ActiveSheet.PivotTables("SASApp:CORPTICK.HISTORICAL_SALES").PivotFields( _
        "event_date").CurrentPage = "(All)"
    With ActiveSheet.PivotTables("SASApp:CORPTICK.HISTORICAL_SALES").PivotFields( _
        "event_date")
        .PivotItems("07/01/2014").Visible = True
        .PivotItems("07/02/2014").Visible = True
        .PivotItems("07/04/2013").Visible = True
        .PivotItems("07/05/2013").Visible = True
    End With
    ActiveWorkbook.Names("_AMO_ContentDefinition_105016702.0").Delete
    ActiveWorkbook.Names("_AMO_ContentDefinition_105016702.1").Delete
    ActiveWorkbook.Names("_AMO_ContentDefinition_105016702.2").Delete
    ActiveWorkbook.Names("_AMO_ContentDefinition_105016702.3").Delete
    ActiveWorkbook.Names("_AMO_ContentDefinition_105016702.4").Delete
    ActiveWorkbook.Names("_AMO_ContentDefinition_105016702.5").Delete
    ActiveWorkbook.Names("_AMO_ContentDefinition_105016702.6").Delete
    ActiveWorkbook.Names("_AMO_ContentDefinition_105016702").Delete
    ActiveWorkbook.Names.Add Name:="_AMO_ContentDefinition_105016702.0", _
        RefersToR1C1:= _
        "=""' Group by dates > move the field to the Report Filters area, then hide the Group items that are outside your desired date ranges.
 
当字段是数据透视表的报表过滤器区域时，您不能对项目进行分组;但是，您可以临时将该字段移动到Row label区域>组的日期为>，将该字段移动到报表过滤器区域，然后隐藏在所需日期范围之外的组项。
 
For a single "between dates" filter this isn't too complicated. Something like this where "A10" is the first PivotItem of your field (the actual code would need to find that cell)...
 
对于一个单独的“间隔日期”过滤器来说，这并不太复杂。像这样，“A10”是字段的第一个数据透视表(实际的代码需要找到该单元格)……
 
Public Function Filter_PivotField_by_Date_Range(pvtField As PivotField, _
        dtFrom As Date, dtTo As Date, Optional ByVal dtFrom2 As Date, Optional ByVal dtTo2 As Date)

 With pvtField
   '--make a rowfield if not already
   If .Orientation <> xlRowField Then .Orientation = xlRowField
   .ClearAllFilters

   '--add code to find a pivotitem
   Range("A10").Group Start:=CLng(dtFrom), End:=CLng(dtTo), _
      Periods:=Array(False, False, _
      False, False, False, False, True)

   '--move to report filters area
   .Orientation = xlPageField
   .Position = 1
 End With

End Function
 
For two "between dates" ranges it can still be done, but you would probably need to make all items visible > sort by date > then use Match or Find to find the start and end of each date range to make groups. 
 
对于两个“间隔日期”范围，它仍然可以执行，但是您可能需要使所有项在日期>之前都是可见的>排序，然后使用Match或Find来查找每个日期范围的开始和结束，以创建组。