Sub tghcn_inewth_2003_yf_()
Application.ScreenUpdating = 0
'================================================================================================================
'Sheets(2).Range("$A$1:$A$" & Sheets(1).[C8]).Select
Sheets(2).Select
Range("$A$1:$A$" & Sheets(1).[C8]).Select
'================================================================================================================
Dim iCount As Long, i As Long, j As Long, k As Long
Dim Str1 As String, Str2 As String
Dim Group As Range
k = 1
iCount = Selection.Cells.Count
    For i = k To iCount
        Str1 = CStr(Selection.Cells(i).Value)
            If Str1 <> "" Then
                For j = i To iCount
                    Str2 = CStr(Selection.Cells(j).Value)
                        If i <> j And Str1 = Str2 Then
                            If Group Is Nothing Then _
                    Set Group = Selection.Cells(j) Else Set Group = Union(Group, Selection.Cells(j))
                            End If
                        Next j
                    End If
                Next i
            On Error Resume Next
Group.Delete Shift:=xlUp
'================================================================================================================
Sheets(1).Select
End Sub

Sub tt()
    Dim d_ As Range
    Application.ScreenUpdating = 0
    Application.DisplayAlerts = 0
    Set d_ = Selection
    n_ = d_.Cells.Count
    d_.Copy
    Sheets.Add.Range("A2").PasteSpecial Paste:=xlPasteValues
    d_.ClearContents
    Range("A1") = "qqq"
    ActiveSheet.UsedRange
'    Calculate
    On Error Resume Next
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "R1C1:R" & n_ + 1 & "C1").CreatePivotTable TableDestination:="R1C3"
    ActiveSheet.PivotTables(1).PivotFields("qqq").Orientation = xlRowField
    ActiveSheet.PivotTables(1).PivotSelect ("qqq[All]")
        Selection.Copy
    d_(1).PasteSpecial (xlPasteValues)
    ActiveSheet.Delete
    Application.DisplayAlerts = 1
End Sub

Sub www(): Sheets(2).Range("A1:A" & Sheets(1).[C8].value).AdvancedFilter 2, , Range("H1"), -1: End Sub

Sub УдалитьДубликаты()
    Dim rng As Range, dict As Object, i As Long, j As Long, mj As Long, arr(), arr1(), arr2, k As String
    On Error Resume Next
    Set rng = Application.InputBox("Выделите диапазон", , , , , , , 8)
    If rng Is Nothing Then Exit Sub
    Set dict = CreateObject("Scripting.dictionary")
    arr = rng.Value
    mj = UBound(arr, 2)
    ReDim arr1(0 To mj - 1)
    For i = 1 To UBound(arr)
        For j = 1 To mj
            arr1(j - 1) = arr(i, j)
        Next
        k = Join(arr1, "|")
        If Not dict.exists(k) Then dict.Add Key:=k, Item:=0
    Next
    ReDim arr(1 To dict.Count, 1 To mj)
    arr1 = dict.keys
    For i = 1 To UBound(arr)
        arr2 = Split(arr1(i - 1), "|")
        For j = 1 To mj
            arr(i, j) = arr2(j - 1)
            MsgBox arr(i, j)
        Next
    Next
    Set rng = Application.InputBox("Выделите первую ячейку диапазона, куда будут выведены уникальные значения", , , , , , , 8)
    If rng Is Nothing Then Exit Sub
    rng.CurrentRegion.ClearContents
    rng.Resize(UBound(arr), mj).Value = arr
End Sub

Sub УдалитьДубликаты1()
    Dim rng As Range, dict As Object, i As Long, j As Long, mj As Long, arr(), arr1(), arr2, k As String
    On Error Resume Next
    Set rng = Application.InputBox("Выделите диапазон", , , , , , , 8)
    If rng Is Nothing Then Exit Sub
    Set dict = CreateObject("Scripting.dictionary")
    arr = rng.Value
    mj = UBound(arr, 2)
    ReDim arr1(0 To mj - 1)
    For i = 1 To UBound(arr)
        For j = 1 To mj
            arr1(j - 1) = arr(i, j)
        Next
        k = Join(arr1, "|")
        If Not dict.exists(k) Then dict.Add Key:=k, Item:=i
    Next
    arr1 = dict.items
    ReDim arr2(1 To dict.Count, 1 To mj)
    For i = 1 To UBound(arr2)
        For j = 1 To mj
            arr2(i, j) = arr(arr1(i - 1), j)
        Next
    Next
    Set rng = Application.InputBox("Выделите первую ячейку диапазона, куда будут выведены уникальные значения", , , , , , , 8)
    If rng Is Nothing Then Exit Sub
    rng.CurrentRegion.ClearContents
    rng.Resize(UBound(arr2), mj).Value = arr2
End Sub