使用VBA

问题描述:

过滤透视表我有主从,我有每天的数据透视表中信息的图表。 我正在尝试创建activeX按钮,以便它可以过滤作为行标签的数据,以查看我的数据在上个星期和上个月的行为如何使用VBA

因此,我到目前为止所拥有的并不是工作是:

私人小组weekbtn1_Click() 暗淡我作为整数

If weekbtn1 = True Then 
i = 0 
Do Until Datavalue(date) - i = 42005 
With ActiveSheet.PivotTables("Pivotcompsprice").PivotFields("Date") 
    .PivotItems DateValue(Date) - i.Visible = False 
    i = i + 1 
End With  
Loop 

i = 0 
Do Until i = 7 
With ActiveSheet.PivotTables("Pivotcompsprice").PivotFields("Date") 
    .PivotItems Datevalue(date) - i.Visible = True 
End With 
Loop 
Else 
End If 

末次

我把这个42005,因为它是我有1/1是数据的最后日期/2015...我是认为这是可以过滤所有的数据为“假的”,然后弄真我想要的东西,但它不工作!

有人可以帮助我吗?

+0

ps:我把vba放在上周......我的意图是对上个月做一些修改的宏 –

这是不可能隐藏在透视字段的所有项目。你总是必须离开至少一个可见的。

如果使用VBA利用内置的日期过滤器功能即这将是更快,更容易: DateFilter

下面是一个示例文件,我做到这一点: https://1drv.ms/x/s!Ah_zTnaUo4DzjhezQ3OTq9tq1APC

注这个功能仅在RowFields或ColumnFields可用。所以我的代码在PageFields上不起作用。

这里有一个通用的程序,让您选择要在筛选透视字段,以及选择性地选择你要计算从前进/后退的日期间隔是什么类型和间隔时间。

Sub Pivots_FilterPeriod(sInterval As String, _ 
         lNumber As Long, _ 
         Optional vRelativeTo As Variant, _ 
         Optional pf As PivotField) 

    'Programmer:  Jeff Weir 
    'Contact:   [email protected] 
    'Description:  Lets you programatically filter a Pivot RowField or ColumnField by specifying 
    '     an interval type (e.g. days, weeks, months, quarters, years) 
    '     as well as an interval count (e.g. 7, -7) 
    '     If the optional vRelativeTo field is left blank, it counts back/foward from 
    '     the youngest/oldest item depending on whether lNumber is positive/negative 
    '     It leverages off the inbuilt DateFilters functionality, and as such does not 
    '     work on RowFields. 


    Dim dteDateAdd As Date 
    Dim dteFrom As Date 
    Dim dteTo As Date 

    On Error GoTo errhandler 

    If pf Is Nothing Then 
     On Error Resume Next 
     Set pf = ActiveCell.PivotField 
     On Error GoTo errhandler 
     If pf Is Nothing Then GoTo errhandler 
    End If 

    With pf 
     If .DataType = xlDate _ 
      And .Orientation <> xlPageField _ 
      And .Orientation <> xlDataField Then 

      If IsMissing(vRelativeTo) Or vRelativeTo = "" Then 
       .AutoSort xlAscending, "Date" 
       If lNumber > 0 Then 
        vRelativeTo = .PivotItems(1) 
       Else 
        vRelativeTo = .PivotItems(.PivotItems.Count) 
       End If 
      End If 

      Select Case UCase(sInterval) 
       Case "D", "DD", "DDD", "DDDD", "DAY", "DAYS": sInterval = "d" 
       Case "W", "WW", "WWW", "WWWW", "WEEK", "WEEKS": sInterval = "ww" 
       Case "M", "MM", "MMM", "MMMM", "MONTH", "MONTHS": sInterval = "m" 
       Case "Q", "QQ", "QQQ", "QQQQ", "QUARTER", "QUARTERS": sInterval = "q" 
       Case "Y", "YY", "YYY", "YYYY", "YEAR", "YEARS": sInterval = "yyyy" 
      End Select 

      dteDateAdd = DateAdd(sInterval, lNumber, vRelativeTo) 
      If lNumber > 0 Then 
       dteDateAdd = dteDateAdd - 1 
      Else 
       dteDateAdd = dteDateAdd + 1 
      End If 

      If dteDateAdd < vRelativeTo Then 
       dteFrom = dteDateAdd 
       dteTo = vRelativeTo 
      Else 
       dteFrom = vRelativeTo 
       dteTo = dteDateAdd 
      End If 

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

      .ClearAllFilters 
      .PivotFilters.Add2 _ 
       Type:=xlDateBetween, _ 
       Value1:=CStr(dteFrom), _ 
       Value2:=CStr(dteTo) 
     End If 
    End With 

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

End Sub 

下面是一些截图,演示了它在使用不同参数时的外观。

这说明如何在最近5天过滤从最近的数据:

Last 5 days from most recent data

,并通过更改标志,它的作品了,我们必须要从最早的数据,第5天记录:

First 5 days from oldest records

如果指定在该领域对于relativeTo的实际日期,它会计算前/后从那里取决于数参数是否为正/ negat我有。下面是今天的日期,未来5天,因为我写这篇文章:

Next 5 days from today

...这是最近5天:

enter image description here

它可以让你指定你是否想天,数周,数季,数月或数年。举例来说,这里是过去两周从最近的记录计数回:

enter image description here

我使用Worksheet_Change事件这里来触发它,但如果你喜欢,你可以把它挂到一个按钮,并给它提供你想要的参数。

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim bContinue As Boolean 
    If Not Intersect(Target, Range("Interval")) Is Nothing Then bContinue = True 
    If Not Intersect(Target, Range("Number")) Is Nothing Then bContinue = True 
    If Not Intersect(Target, Range("RelativeTo")) Is Nothing Then bContinue = True 
    If bContinue Then Pivots_FilterPeriod [Interval], [Number], [RelativeTo], Sheet1.PivotTables(1).PivotFields("Date") 

End Sub