excel - 标记和过滤重复 ListObject VBA

Question

我试图在 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

标签： excelvbaduplicatesconditional-statementslistobject

Answer 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

结束子