Sub Ab()
Dim v(), i&, j&, di1 As Object, di2 As Object
  Set di1 = CreateObject("scripting.dictionary")
  Set di2 = CreateObject("scripting.dictionary")
  v = Range("A2", Cells(Rows.Count, "B").End(xlUp)).Value
  For i = 1 To UBound(v)
    di1(v(i, 1)) = Empty
    di2(v(i, 2)) = Empty
  Next
  For i = 1 To UBound(v)
    di1(v(i, 2)) = Empty
    di2(v(i, 1)) = Empty
  Next
  On Error GoTo 0
  Range("E2").Resize(di1.Count) = WorksheetFunction.Transpose(di1.keys)
  Range("F1").Resize(, di1.Count) = di2.keys
  With Range("F2").Resize(di1.Count, di2.Count)
    .Formula = Replace("=COUNTIFS($A$2:$A$~,$E2,$B$2:$B$~,F$1)&"";""&COUNTIFS($B$2:$B$~,$E2,$A$2:$A$~,F$1)", "~", UBound(v) + 1)
    .Value = .Value 'необязательно
  End With
End Sub