最终方案编辑:
首先，我很抱歉耽误了这么长时间。写完这篇文章后不久，我就出城了，然后被拉下了这个项目，直到最近我能找到时间来做它。Jerry给了我一个好主意，在行标签上使用组，而不是试图一次过滤一个日期。经过一些修改，我能够以更快的速度满足我的需求。在最慢的情况下，我已经将时间从5分钟以上减少到45秒，并且随着时间的推移，我仍然希望进行优化。这是一个很好的方法，它允许我更新几个相关的数据透视表。
对于那些可能觉得它有用的人来说，它包含了很多额外的代码:
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
结束子
我已经绞尽脑汁了好几天试图弄清楚这个问题，所以任何帮助都是非常感激的!
我的问题:
我有一个数据透视表，它声明了一个日期报告过滤器，我循环通过给定的一些单元格输入，以便动态过滤数据。我让循环正确运行并过滤数据，但是它可能需要大量的时间来循环每个项目的可见属性(从完整的项目列表到较小的子集需要3.5分钟)。我在网上广泛搜索后，正在寻找优化这一点的方法(说真的，我至少花了6个多小时寻找)。很明显是枢轴。这需要很长时间(每个条目都要花一秒钟)，我似乎找不到一种方法来加快速度。
我试过了:
在我的代码(如下)，我已经尝试/做了以下:
设置应用程序设置为false
With Application .ScreenUpdating = False .EnableEvents = False .DisplayAlerts = False .CalculationMethod = xlManual End with在数据透视项上设置手动更新字段。
With Pivottable("somepivottable").Pivotfields("thatonefield") .ManaulUpdate = True End with- 这实际上似乎不工作，因为即使将应用程序设置设置为false和手动更新设置为true，我仍然可以清楚地看到应用程序在将项目设置为可见时暂停(大约0.5到完整秒每个项目正在改变其可见状态)
尝试将过滤器设置为另一个数据透视表上的列(通过同一缓存中的切片器连接)并设置标签过滤器。没想到这能行…没有。
尝试在枢轴上宏记录实际的过滤器选择过程(这几乎是瞬时的)。根据我从中得到的，我试图显式地声明每个pivot项目为真或假，但这与我的标准代码有相同的周转时间。
这就是我现在的处境。我没有别的主意。我的数据透视表实际上是从SAS数据集(平面文件，而不是OLAP立方体)创建的，因此数据在物理上不是在工作簿中，这是我喜欢的，因为数据接近800k行，并且可能继续增长到两倍的大小。由于SAS插件将数据直接拉入枢轴缓存，因此可以避免数据限制。
My Code So Far:
这仍然是相当粗糙的，因为我仍然在整理一些好的点，尽管我当然也对其他优化持开放态度。该代码是从用户表单调用的，它是我从这里找到的代码的修改副本，并修改为接受两个连续的日期范围。
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
我没有注意到更新进度用户表单的任何命中(只是一个进度条，因为它花了很长时间，让用户知道它实际上在工作)。如果我可以通过删除它来使它工作得更快，我会这样做，但到目前为止，即使使用DoEvents调用，它也需要很长时间。我还尝试将工作簿中的所有数据透视表设置为manualupdate=true，而只是当前的数据透视表，没有变化。
我注意到的一件事是，当代码中断时(或者我插入一个断点/步骤)，manualupdate属性设置回false。我不确定这是设计的，还是我的工作簿/数据透视表有特别的问题。
我也试图找到一种方法来使用数组批量应用可见属性，但它似乎不可能。
谢谢你可能提供的任何帮助，我非常感激，如果你需要我的什么，请告诉我。
编辑回复一些评论(感谢大家的回复!)
- 首先，我很抱歉忘记提到这一点，但我使用Excel 2010 32位。
下面是我在宏记录报告过滤器或切片器更改时得到的代码示例。通过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:= _
"=""'<ContentDefinition name=""""SASApp:CORPTICK.HISTORICAL_SALES"""" rsid=""""105016702"""" type=""""PivotTable"""" format=""""ReportXml"""" imgfmt=""""ActiveX"""" created=""""07/01/2014 11:56:37"""" modifed=""""07/16/2014 15:31:46"""" user=""""xxx"""" apply=""""False"""" css='"""
' And if I adjust a slicer - I've removed a lot of the code for the sake of length but it was mostly just all .Selected=False for all the non-selected code.
With ActiveWorkbook.SlicerCaches("Slicer_event_date")
.SlicerItems("07/03/2013").Selected = True
.SlicerItems("07/04/2013").Selected = True
.SlicerItems("07/05/2013").Selected = True
.SlicerItems("07/06/2013").Selected = 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:= _
"=""'<ContentDefinition name=""""SASApp:CORPTICK.HISTORICAL_SALES"""" rsid=""""105016702"""" type=""""PivotTable"""" format=""""ReportXml"""" imgfmt=""""ActiveX"""" created=""""07/01/2014 11:56:37"""" modifed=""""07/16/2014 15:31:46"""" user=""""xxx"""" apply=""""False"""" css='"""
End Sub
您是否考虑过您只是遇到了EXCEL(在今天的硬件上)处理数据透视表的限制:
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
你说的是800K行数据，可能很快翻倍到1600k行，而EXCEL最近才突破65K的限制。
另一种方法是按日期范围对Rowfield项进行分组，然后按这些组进行筛选。
当字段是数据透视表的报表筛选区域时，不能对项目进行分组;但是，您可以将该字段临时移动到"行标签"区域>按日期分组>将该字段移动到"报告过滤器"区域，然后隐藏超出所需日期范围的组项。
对于单个"between dates"过滤器，这并不太复杂。像这样，"A10"是字段的第一个PivotItem(实际代码需要找到该单元格)…
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
对于两个"日期之间"的范围，仍然可以这样做，但是您可能需要使所有项可见>按日期排序>然后使用Match或Find来查找每个日期范围的开始和结束以进行分组。
如何修改SAS数据集的查询，仅返回指定日期范围内的记录?
如果您使用Excel 2007或更高版本，您可以将PivotFilter添加到PivotField并使用xlDateBetween类型在日期范围内进行过滤(这将涵盖blSingleRange = True:
pvtField.PivotFilters.Add Type:=xlDateBetween, Value1:=CLng(dtFrom), Value2:=CLng(dtTo)