Sub Макрос4()
'
' Макрос4 Макрос
'

'
     ActiveSheet.Range("$A$1:$A$17").AutoFilter Field:=1, Operator:= _
         xlFilterNoFill
End Sub

Sub qqq()
      Dim arr, ar, ar1, cl, i&, j&
      With ActiveSheet.Range("$A$1:$A$17")
      arr = .Value
      ReDim ar(UBound(arr) - 1): ReDim ar1(UBound(arr) - 1)
      .AutoFilter Field:=1, Operator:=xlFilterNoFill
      For Each cl In .Cells.SpecialCells(xlCellTypeVisible)
          ar(i) = cl.Value: i = i + 1
      Next
      For i = 1 To UBound(arr)
          For j = 0 To UBound(ar) - 1
              If arr(i, 1) = ar(j) Then ar1(i - 1) = Empty: Exit For
              ar1(i - 1) = CStr(arr(i, 1))
              If ar1(i - 1) = Empty Then Exit For
          Next: Next
      .AutoFilter
      .AutoFilter Field:=1, Criteria1:=ar1, Operator:=xlFilterValues
      End With
End Sub