基于活动单元格筛选PivotTable3的错误排查及代码调整问询

让我拆解下你这段代码里的问题，以及怎么调整才能实现你的需求：

当前代码的核心错误 #

• 硬编码了筛选值来源：你现在把NewCat固定设置成了U10单元格的值，不管你选中U8:U37里的哪个单元格，最终都是用U10的内容去筛选数据透视表，这完全偏离了你“用任意选中的活动单元格作为筛选依据”的目标。
• 未处理多单元格选中的情况：Worksheet_SelectionChange事件的Target参数可能包含多个单元格，如果用户选中了U8:U37范围内的多个单元格，直接取值会触发错误，所以得提前拦截这种场景。
• 缺乏错误处理：如果数据透视表、目标字段不存在，或者选中的单元格值不在透视表的项目列表里，代码会直接弹出运行时错误，体验很差。

修正后的代码 #

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' 仅处理U8:U37范围内的单个单元格选中事件
    If Intersect(Target, Range("U8:U37")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
    
    Dim pt As PivotTable
    Dim Field As PivotField
    Dim NewCat As String
    
    ' 容错：避免找不到透视表或字段时出错
    On Error Resume Next
    Set pt = Worksheets("mPIVOTS").PivotTables("PivotTable3")
    Set Field = pt.PivotFields("Project")
    On Error GoTo 0
    
    ' 直接取当前选中的活动单元格的值作为筛选条件
    NewCat = Target.Value
    
    With pt
        ' 确认找到目标字段后再执行操作
        If Not Field Is Nothing Then
            Field.ClearAllFilters
            
            ' 尝试设置筛选值，不存在则提示
            On Error Resume Next
            Field.CurrentPage = NewCat
            If Err.Number <> 0 Then
                MsgBox "选中的项目不存在于数据透视表中，请检查！"
                Err.Clear
            End If
            On Error GoTo 0
            
            pt.RefreshTable
        End If
    End With
End Sub

关键改动说明 #

1. 锁定单个单元格筛选：在开头的判断里新增Target.Cells.Count > 1，确保只有选中单个单元格时才执行筛选逻辑，避免多单元格选中导致的异常。
2. 替换筛选值来源：把NewCat的取值改成Target.Value，直接获取当前选中的活动单元格内容，完美匹配你的需求。
3. 增加容错机制：加入On Error语句和字段存在判断，避免因透视表、字段不存在或筛选值无效导致的崩溃，还会给用户友好的提示。

内容的提问来源于stack exchange，提问作者t.mo