VBA实现ListObject动态表列重复值查找标记与筛选求助

原脚本不兼容动态表的核心原因 #

• 全程硬编码固定单元格地址（如B列范围、B1:J1筛选区域），未绑定ListObject对象引用，当动态表新增/删除行、调整列顺序时，定位范围会完全失效
• 重复值统计范围未排除ListObject表头行，易将表头文本误判为重复值
• 直接遍历整列的逻辑在动态表场景下会包含表外的空白行，导致统计偏差
• 筛选逻辑未复用ListObject内置的表筛选接口，硬编码地址在表结构变动时会触发范围错误

可直接运行的适配代码 #

Sub Duplicates()
    ' 保留原形状状态切换逻辑，无需修改
    ActiveSheet.Shapes("shape3").Select
    If Selection.ShapeRange.Fill.Visible = msoFalse Then
        Selection.ShapeRange.Fill.Visible = msoTrue
        Selection.ShapeRange.Fill.Solid
        Selection.ShapeRange.Fill.ForeColor.SchemeColor = 40
    Else
        Selection.ShapeRange.Fill.Visible = msoFalse
    End If
    
    Dim lo As ListObject
    Dim targetCol As ListColumn
    Dim dupRange As Range
    Dim cel As Range
    
    ' 绑定当前工作表的ListObject，替换为实际使用的表名即可
    Set lo = ActiveSheet.ListObjects("Table1")
    ' 绑定需做重复值校验的目标列，替代原硬编码的B列定位
    ' 可直接写列名引用，如lo.ListColumns("单据编号")，避免列位置变动导致定位错误
    Set targetCol = lo.ListColumns(2)
    
    ' 清除目标列原有格式标记，避免残留颜色干扰结果
    targetCol.DataBodyRange.Interior.ColorIndex = xlNone
    
    ' 仅在ListObject数据行范围内统计重复值，自动排除表头、表外空白行
    Set dupRange = targetCol.DataBodyRange
    For Each cel In dupRange
        If WorksheetFunction.CountIf(dupRange, cel.Value) > 1 Then
            cel.Interior.ColorIndex = 3
        End If
    Next cel
    
    ' 调用ListObject内置筛选接口，替代原硬编码的固定地址筛选
    lo.Range.AutoFilter Field:=targetCol.Index, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterCellColor
    lo.Range.AutoFilter Field:=9, Criteria1:="<>0", Operator:=xlAnd
    
    ActiveWindow.SmallScroll Down:=-9
End Sub

运行说明 #

• 代码中Table1需替换为工作表中实际存在的ListObject表名
• 目标列的定位支持两种方式：列索引（从1开始计数）、列标题文本，推荐使用列标题文本做绑定，彻底避免列顺序调整带来的定位错误
• 重复值统计范围由ListObject的DataBodyRange自动维护，随表行的新增、删除自动调整边界，不需要手动计算最后一行位置
• 代码新增了重复运行前的格式清除逻辑，避免反复执行脚本时旧的红色标记残留

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