VBA实现数据透视表pmf_VINT_M36字段按年度区间自动分组咨询

完整补充后代码 #

你可以直接用以下代码替换原标记位置的内容即可实现需求：

wb.Sheets("analysis-tabele").Activate
wb.Sheets("analysis-tabele").Range("A4:A5").Select
    Selection.Group
    ' 处理pivot5的pmf_VINT_M36字段勾选倒数第二个选项
    With ActiveSheet.PivotTables("pivot5").PivotFields("pmf_VINT_M36")
        ' 关闭透视表自动更新，提升运行效率避免卡顿
        Parent.ManualUpdate = True
        ' 重置字段筛选，避免已有筛选条件干扰选项计数
        .ClearAllFilters
        Dim itemCount As Long
        itemCount = .PivotItems.Count
        ' 透视表PivotItem索引从1开始，总数量减1即为倒数第二个选项的索引
        Dim targetIndex As Long
        targetIndex = itemCount - 1
        ' 先勾选目标项，避免后续取消其他项时出现无选中项的报错
        .PivotItems(targetIndex).Visible = True
        ' 遍历取消其余所有选项的勾选
        Dim i As Long
        For i = 1 To itemCount
            If i <> targetIndex Then
                .PivotItems(i).Visible = False
            End If
        Next
        ' 恢复透视表自动更新
        Parent.ManualUpdate = False
    End With
wb.Sheets("analysis-tabele").Range("B4:N19").Copy Destination:=wb.Sheets("analysis-tabele").Range("B21")

可选扩展（日期分组命名） #

如果你需要额外实现形如2020M06的日期归类到Grupuj1分组的需求，可在上述With代码块中补充以下逻辑：

' 放在End With前即可
If Left(.PivotItems(targetIndex).Value, 4) = "2020" Then
    .DataRange.Cells(1).Group Name:="Grupuj1"
End If

内容的提问来源于stack exchange，提问作者Przemek Dabek