Sub bb()
Dim i&, j&
'1 этап - поиск аномалий
i = 3
While Cells(i, 1) <> ""
  If Cells(i, 1) = Cells(i - 1, 2) And Cells(i, 2) = Cells(i - 1, 1) Then
    Cells(i - 1, 3) = "OK": Cells(i, 3) = "OK"
    Cells(i - 1, 1).Resize(2, 2).Interior.ColorIndex = xlColorIndexNone
    i = i + 2
  Else
    Cells(i - 1, 3) = "без пары": Cells(i, 3) = "без пары"
    Cells(i - 1, 1).Resize(2, 2).Interior.Color = vbBlue
    i = i + 1
  End If
Wend
If Cells(i - 1, 3) = "" And Cells(i - 1, 2) <> "" Then
  Cells(i - 1, 3) = "без пары"
  Cells(i - 1, 1).Resize(, 2).Interior.Color = vbBlue
End If

'2 этап - поиск разрывов
For i = 2 To 16
  If Cells(i, 3) = "без пары" Then
    For j = 2 To i - 1
      If Cells(j, 3) = "без пары" Then
        If Cells(i, 1) = Cells(j, 2) And Cells(i, 2) = Cells(j, 1) Then
          Cells(i, 3) = "разрыв пары": Cells(j, 3) = "разрыв пары"
          Cells(i, 1).Resize(, 2).Interior.Color = vbRed
          Cells(j, 1).Resize(, 2).Interior.Color = vbRed
          Exit For
        End If
      End If
    Next
  End If
Next
End Sub