基于动态范围值的VBA透视表筛选失效问题排查及方案咨询

我来帮你拆解下代码里的问题，以及给出能正常工作的修复方案：

问题根源分析 #

• 未初始化变量就使用：初始代码里直接用LR0计算最后一行，但这个变量根本没赋值，会导致lastRange变成无效地址，筛选范围从根源就错了。
• 工作表上下文混乱：你把star定义为Peer Code表的单元格地址，但之后激活了Conso_Input工作表，Range(star)会默认在当前激活的Conso_Input里找这个地址，而不是Peer Code表——这就导致CountIf永远找不到匹配项，筛选自然失效。
• 空值处理缺失：代码里没针对空的PivotItem做排除，可能会留下空值显示，不符合你「排除空值」的需求。

修复后的解决方案 #

这里给出更健壮的代码，解决上述所有问题，同时优化性能：

Sub FilterPivotTableByFundCode()
    Dim wsPeer As Worksheet
    Dim wsConso As Worksheet
    Dim LR0 As Long
    Dim targetRange As Range
    Dim targetValues As Variant
    Dim PvtTbl As PivotTable
    Dim PvtFld As PivotField
    Dim PI As PivotItem
    Dim matchFound As Boolean
    Dim i As Long
    
    ' 明确指定工作表，完全避免依赖Activate/Select
    Set wsPeer = ThisWorkbook.Sheets("Peer Code")
    Set wsConso = ThisWorkbook.Sheets("Conso_Input")
    
    ' 获取Peer Code表J列的有效数据范围（从J2到最后一行）
    LR0 = wsPeer.Range("J" & wsPeer.Rows.Count).End(xlUp).Row
    Set targetRange = wsPeer.Range("J2:J" & LR0)
    
    ' 将目标范围的值存入数组，大幅提高匹配效率
    targetValues = targetRange.Value
    
    ' 引用数据透视表和目标字段
    Set PvtTbl = wsConso.PivotTables("PivotTable1")
    Set PvtFld = PvtTbl.PivotFields("FundCode")
    
    ' 清除现有筛选
    PvtTbl.ClearAllFilters
    
    ' 遍历所有透视项，设置可见性
    For Each PI In PvtFld.PivotItems
        ' 优先处理空值：直接隐藏，满足排除空值的需求
        If PI.Name = "" Then
            PI.Visible = False
            GoTo NextPI
        End If
        
        ' 检查当前透视项是否在目标数组中
        matchFound = False
        For i = 1 To UBound(targetValues, 1)
            If targetValues(i, 1) = PI.Name Then
                matchFound = True
                Exit For
            End If
        Next i
        
        PI.Visible = matchFound
NextPI:
    Next PI
End Sub

代码优化点说明 #

• 抛弃Activate/Select：直接通过工作表对象引用，彻底避免上下文切换导致的错误，代码稳定性大幅提升。
• 数组匹配替代CountIf：相比多次调用WorksheetFunction.CountIf，数组遍历的效率更高，尤其是当目标数据量大的时候。
• 明确处理空值：专门判断空的透视项，直接设置为隐藏，精准满足你「排除空值」的需求。
• 变量类型更严谨：用Long代替Integer存储行号，避免Excel行号超过Integer上限（65535）的潜在问题。

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