Sub zxc()
    Dim a, b As Integer
    
    For i = 2 To 8
        If Cells(i, 2) = "" And Cells(i, 3) = "" And Cells(i, 4) = "" And Cells(i, 5) = "" Then
         Rows(i).Delete
        End If
    Next
Range("A1:E1").AutoFilter
    ActiveWorkbook.Worksheets("Лист1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Лист1").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Лист1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
For i = 2 To 8
    If Cells(i + 1, 1) = Cells(i, 1) Then
        a = Len(Cells(i, 2) & Cells(i, 3) & Cells(i, 4) & Cells(i, 5))
        b = Len(Cells(i + 1, 2) & Cells(i + 1, 3) & Cells(i + 1, 4) & Cells(i + 1, 5))
        If a > b Then
        Rows(i + 1).Delete
        Else
        Rows(i).Delete
        End If
    End If
Next
End Sub

Sub qq()
    Dim ar, aitems, arez
    Dim i&, j&
    ar = [a2:e8].Value
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(ar)
            If .exists(ar(i, 1)) Then
                If Len(ar(i, 5)) Then
                    If Len(ar(i, 2)) Then
                        If Split(.Item(ar(i, 1)), "|")(0) < 3 Then .Item(ar(i, 1)) = 3 & "|" & i
                    Else
                        If Split(.Item(ar(i, 1)), "|")(0) < 2 Then .Item(ar(i, 1)) = 2 & "|" & i
                    End If
                End If
            Else
                .Item(ar(i, 1)) = 1 + IIf(Len(ar(i, 2)), 2, 1) & "|" & i
            End If
        Next
        aitems = .items
        ReDim arez(1 To .Count, 1 To 5)
        For i = 1 To UBound(arez)
            For j = 1 To 5
                arez(i, j) = ar(Val(Split(aitems(i - 1), "|")(1)), j)
            Next
        Next
    End With
    [G2].Resize(UBound(arez), UBound(arez, 2)) = arez
End Sub