Sub CountDifference()
With Me.UsedRange.Columns( 2 )

     iCountA = Application.CountA(.Cells)
     For Each iCell In .Cells
         iCount = iCountA - .Cells.ColumnDifferences(iCell).Count
         
      If iCount >  1  Then
      
      MsgBox iCell.Value & "-" & iCount, , ""
         
     End If
      
     Next
        
End With

End Sub

    Dim rng As Range
    Dim arr( 1  To  18 ,  1  To  2 ) As Variant
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim bln As Boolean
    
    i =  1 
    
    For j =  2  To  19 
        Set rng = ThisWorkbook.Worksheets("Лист1").Range("A" & j)
        bln = False
        If i =  1  Then
            bln = False
        Else
            For k = LBound(arr,  1 ) To UBound(arr,  1 )
                If Not IsEmpty(arr(k,  1 )) _
                  And Not IsEmpty(arr(k,  2 )) Then
                    If arr(k,  1 ) = rng.Value _
                      And arr(k,  2 ) = rng.Offset( 0 ,  1 ).Value Then
                        rng.EntireRow.Delete Shift:=xlUp
                        j = j -  1 
                        bln = True
                        Exit For
                    End If
                End If
            Next k
        End If
        If Not bln Then
            arr(i,  1 ) = rng.Value
            arr(i,  2 ) = rng.Offset( 0 ,  1 ).Value
            i = i +  1 
        End If
    Next j