重命名过滤器值

Question

我有一个宏，它应该更改工作表“ veckorapport”上5个数据透视表上的“ WEEK”过滤器。

此宏在某种程度上将“星期几”的“名称”更改为我在输入框中输入的数字/文本。请看第一张图片，此数字应按降序排列。

我的代码：

Sub Veckorapport_filter()
Dim num As String
Dim sht As Worksheet
Set sht = Sheets("Veckorapport")
num = InputBox(Prompt:="Vecka", Title:="ENTER WEEK")
sht.PivotTables("PivotTable1") _
    .PivotFields("WEEK").CurrentPage = num
sht.PivotTables("PivotTable2") _
    .PivotFields("WEEK").CurrentPage = num
sht.PivotTables("PivotTable3") _
    .PivotFields("WEEK").CurrentPage = num
sht.PivotTables("PivotTable4") _
    .PivotFields("WEEK").CurrentPage = num
sht.PivotTables("PivotTable5") _
    .PivotFields("WEEK").CurrentPage = num
End Sub

我在两件事上需要帮助：如何编写此代码，以使其在过滤器中的Weeks上不会更改“名称”？

第二点：如何在过滤器列表中将名称改回适当的名称？

链接到图片：https://imgur.com/kndEnm6

编辑：想象一下它的外观：https://imgur.com/CU9fWex

编辑2：那两个星期换了地方。它应按降序排列：https://imgur.com/PVS3JMf

Answer 1

要遍历工作表上的所有数据透视表：

Sub Veckorapport_filter()
Dim num As String
Dim sht As Worksheet
Set sht = Sheets("Veckorapport")
num = InputBox(Prompt:="Vecka", Title:="ENTER WEEK")
If len(num) <> 0 then
  dim pt as pivottable
  for each pt in sht.pivottables
    with pt.PivotFields("WEEK")
       .clearallfilters
      .CurrentPage = num
    end with
  next pt
 end if
End Sub

Answer 2

如果将'mat-horizontal-content-container'更改为不存在，则它将重命名当前选择的页面/项目。 （如果您手动进行此操作，而不是通过VBA进行操作，则会出现一个确认框，“在数据透视表报表中不存在该名称的项目。将'Old_Name'重命名为'New_Name'吗？”，并单击“确定”和“取消“按钮）

您可以通过确保为该字段启用“显示没有数据的项目”来部分地防止这种情况，和/或可以在更改.CurrentPage之前使用WorksheetFunction.CountIf检查该值是否存在< / p>

关于重置项目：将.CurrentPage中的.Name，.Value或.Caption重新设置为PivotItem：

SourceName

如果已将名称切换为2个项目，则会遇到问题（同一名称不能重复存在两次），因此您需要检查正在使用的名称，或者仅用2蛮行使用循环-这可能是写起来更简单的解决方案：

Dim piTMP AS PivotItem, pfTMP AS PivotField
Set pfTMP = sht.PivotTables("PivotTable1").PivotFields("WEEK")
For Each piTMP In pfTMP.PivotItems
    piTMP.Name = piTMP.SourceName
Next piTMP