Question

如果可能，请有人提供代码，使我能够在多个数据透视表上自动更改周数过滤器的过程。

我每周生成一份报告，需要10周的时间范围。因此，每周我必须从众多数据透视表中删除已成为第11周的周过滤器，并添加到前一周的周过滤器。

我提供了该过程的录制宏版本以及该表的屏幕截图以帮助解释。我尝试了各种搜索但我找不到任何相关内容。任何可以提供的帮助我将非常感激。

Image of pivot table before filter is updated

Sub Macro2()
'
' Macro2 Macro
'
'
Range("B15").Select
ActiveSheet.PivotTables("TopPvt").PivotCache.Refresh
With ActiveSheet.PivotTables("TopPvt").PivotFields("Week")
    .PivotItems("45").Visible = False
    .PivotItems("3").Visible = True
End With
Range("B21").Select
End Sub

Answer 1

试试这个：

Sub Test2()

Dim firstdate As Integer, seconddate As Integer

seconddate = Format(Date, "ww") - 1
firstdate = Format(Date - 84, "ww") - 1

Range("B15").Select
ActiveSheet.PivotTables("TopPvt").PivotCache.Refresh
With ActiveSheet.PivotTables("TopPvt").PivotFields("Week")
    .PivotItems(firstdate).Visible = False
    .PivotItems(seconddate).Visible = True
End With
Range("B21").Select

End Sub

Answer 2

此代码是我的问题的解决方案。感谢Taccoo73和我的一些调整，我能够让代码工作，我需要它。

周数，例如需要将47到4放入指定的单元格中。因此，47需要放在“c4”中，52放在“d4”中，1放入“e4”，4放入“f4”。

Sub test150()

Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim begin As Integer
Dim finish As Integer
Dim begintwo As Integer
Dim finishtwo As Integer


On Error GoTo Err
begin = Range("c4")
finish = Range("d4")
begintwo = Range("e4")
finishtwo = Range("f4")


For Each pt In ActiveSheet.PivotTables


Set pf = pt.PivotFields("Week")


    pf.EnableMultiplePageItems = True

For Each pi In pf.PivotItems

    pi.Visible = pi >= begin And pi <= finish Or pi >= begintwo And pi <= finishtwo

Next pi
Next pt


Err:
Resume Next

MsgBox "Finished"

End Sub

用于移动枢轴表过滤器范围的VBA解决方案，用于周数

2 个答案: