|
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
|
|