| 
    
     |  | Sub vivi() Dim VsR1 As Range, VsR2 As Range, VsR3 As Range, MxYer As Long
 Dim cc As Range, tb() As String
 AER = Range("A65536").End(xlUp).Row
 Range("A1:A" & AER).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
 Set VsR1 = Range("A2:A" & AER).SpecialCells(xlVisible)
 ActiveSheet.ShowAllData
 ReDim tb(1 To VsR1.Count)
 For Each cc In VsR1
 i = i + 1
 tb(i) = cc
 Next
 Set VsR1 = Nothing
 For i = 1 To UBound(tb)
 AER = Range("A65536").End(xlUp).Row
 Range("A1").AutoFilter Field:=1, Criteria1:=tb(i)
 Set VsR2 = Range("B2:B" & AER).SpecialCells(xlVisible)
 MxYer = Application.Max(VsR2)
 Range("A1").AutoFilter Field:=2, Criteria1:="<" & MxYer, Operator:=xlAnd
 Set VsR3 = Range("B2:B" & AER).SpecialCells(xlVisible)
 VsR3.EntireRow.Delete
 ActiveSheet.ShowAllData
 DoEvents
 Next
 Set VsR2 = Nothing: Set VsR3 = Nothing
 Erase tb
 End Sub
 
 |  |