मैं बिना सफलता के 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
0
Rita Fainshtein 30 जिंदा 2021, 09:03

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

अंत उप

Before After After (ResetFilter)

0
Алексей Р 30 जिंदा 2021, 11:15