标记和过滤重复 ListObject VBA答案

【问题标题】：Mark and Filter duplicates ListObject VBA标记和过滤重复 ListObject VBA
【发布时间】：2021-05-04 00:02:20
【问题描述】：

我试图在 ListObject（动态表的列）VBA 中查找、标记和过滤重复项，但没有成功。以下脚本适用于常规范围，我做了一些更改并需要它用于列表对象。非常感谢您的帮助

sub Duplicates()
    
    ActiveSheet.Shapes("shape3").Select 'change to whatever your shape is called
    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 Rng As Range
    Dim cel As Range
    
    'Test for duplicates in a single column
    'Duplicates will be highlighted in red
    
    Set Rng = Range(Range("B1"), Range("B" & Rows.Count).End(xlUp))
    
    For Each cel In Rng
    If WorksheetFunction.CountIf(Rng, cel.Value) > 1 Then
    
    cel.Interior.ColorIndex = 3
    End If
    Next cel
    
    Range("B:J").Select
    
    ActiveSheet.Range("$B$1:$J$1").AutoFilter Field:=1, Criteria1:=RGB(255, 0 _
    , 0), Operator:=xlFilterCellColor
    ActiveWindow.SmallScroll Down:=-9
    ActiveSheet.Range("$B$1:$J$1").AutoFilter Field:=9, Criteria1:="<>0", _
    Operator:=xlAnd

End Sub

【问题讨论】：

标签： excel vba duplicates conditional-statements listobject

【解决方案1】：

一种方法是使用条件格式：

Sub FilterDups()
Dim LO As ListObject, FC As UniqueValues

Set LO = ActiveSheet.ListObjects(1) ' Dynamic Table
Set FC = LO.DataBodyRange.Columns(1).FormatConditions.AddUniqueValues   ' UniqueValues object to quickly visualize cells that contain either unique or duplicate values
With FC
    .SetFirstPriority
    .DupeUnique = xlDuplicate
    .Interior.Color = vbRed ' red color for duplicate values
End With

LO.Range.AutoFilter Field:=1, Criteria1:=RGB(255, 255, 255), Operator:=xlFilterNoFill ' filter out duplicate values

结束子

【讨论】：