XL 2010 Doublons de couples de nombres

=NB.SI.ENS(A$1:A$7;A1;B$1:B$7;B1)+(A1<>B1)*NB.SI.ENS(A$1:A$7;B1;B$1:B$7;A1)

=SOMMEPROD(SIGNE(NBVAL($A1:$B1)*(($A1&" "&$B1=$A$1:$A$1000&" "&$B$1:$B$1000)+($B1&" "&$A1=$A$1:$A$1000&" "&$B$1:$B$1000))))>1

Sub Hop()
   Dim plage As Range, t
   'on peut n'afficher qu'une seule colonne en supprimant la ligne
   ' qui ne nous intéresse pas(ou la mettant en commentaire)
   With Worksheets("Feuil1")
      Set plage = .Range("a1:d" & Cells(Rows.Count, "a").End(xlUp).Row)
      'affichage du nombre d'occurrence dans la colonne E
      t = Occurrences(plage)
      .Cells(plage.Row, "e").Resize(UBound(t), 1) = t
      'affichage des textes d'indexation (le 2ème paramètre est présent - il est quelconque)
      'dans la colonne G
      t = Occurrences(plage, 999)
      .Cells(plage.Row, "g").Resize(UBound(t), 1) = t
   End With
End Sub

Function Occurrences(plage As Range, Optional Texte)
Dim collec As New Collection, y, n&, i&, j&
Dim t, ech As Boolean, aux, repet As New Collection, quoi&

   Application.ScreenUpdating = False
   t = plage.Value   'lecture de la plage de valeurs
   'si une seule colonne alors on en rajoute une
   If UBound(t, 2) = 1 Then ReDim Preserve t(1 To UBound(t), 1 To UBound(t, 2) + 1)
   On Error Resume Next 'pour la gestion des collections
   'boucle d'indexation des éléments distincts des valeurs
   For i = 1 To UBound(t)
      For j = 1 To UBound(t, 2)
         y = "": y = collec(LCase(t(i, j)))
         If y = "" Then
            'la valeur n'est pas dans collec
            n = n + 1   'nouvel index
            collec.Add n, LCase(t(i, j))  'on ajoute l'index avec pour clef LCase(t(i, j))
            t(i, j) = n 'on place l'index à la place de la valeur de t(i,j)
         Else
            'la valeur de l'index est déjà dans collec
            t(i, j) = y    'on place cette valeur dans t(i,j)
         End If
      Next j
   Next i
   'les valeurs de t on été maintenant remplacées par leur index (unique pour chaque valeur distincte)
 
   'tri des index de chaque ligne de t (méthode classique par échange)
   For i = 1 To UBound(t)
      Do
         ech = False
         For j = 1 To UBound(t, 2) - 1
            If t(i, j) > t(i, j + 1) Then
               ech = True: aux = t(i, j): t(i, j) = t(i, j + 1): t(i, j + 1) = aux
            End If
         Next j
      Loop Until Not ech
   Next i
   
   For i = 1 To UBound(t)
      'on met dans chaque élément de la première colonne de chaque ligne
      'le texte des index de la ligne (chaque index du texte est entouré avec le caractère "|"
      y = ""
      For j = 1 To UBound(t, 2): y = y & "|" & t(i, j) & "|": Next
      t(i, 1) = y
     
      'puis on se sert de la collection repet pour compter le nombre d'occurrence de chaque texte
      y = "": y = repet(t(i, 1))
      If y = "" Then
         'le texte n'existe pas alors on ajoute 1 à la collection avec la clef texte ( = t(i,1) )
         repet.Add 1, t(i, 1)
      Else
         'la clef texte existe déjà, on la supprime, on la rajoute en incémentant de 1 la valeur existante
         repet.Remove t(i, 1)
         repet.Add y + 1, t(i, 1)
      End If
   Next i
 
   'on place dans la deuxième colonne de t le nombre d'occurrence du texte de la 1ère colonne de t
   For i = 1 To UBound(t): t(i, 2) = repet(t(i, 1)): Next
 
   'Quoi Retourner: Nombre d'occurrence ou bien texte avec les index ?
   If IsMissing(Texte) Then
      'on retourne le nombre d'occurrence
      For i = 1 To UBound(t): t(i, 1) = t(i, 2): Next
   End If
  Occurrences = Application.Index(t, 0, 1)     'on renvoie le tableau désiré
End Function

Public Function VersusJA(ByVal J As Long, ByVal A As Long) As Long
   If A < J Then A = A Xor J: J = J Xor A: A = A Xor J
   If A > J Then VersusJA = A * (A - 3) \ 2 + J Else VersusJA = -1
   If VersusJA < 0 Then Err.Raise 9999, , "VersusJA(" & J & ", " & A & ") impossible."
   End Function
Public Function JAVersus(ByVal VS As Long)
   Dim J As Long, A As Long
   A = Int(Sqr(2 * VS + 0.25) + 1.5)
   J = VS - A * (A - 3) \ 2
   JAVersus = Array(J, A)
   End Function

Function Xconcat(r As Range)
Dim a(), i&, v
ReDim a(r.Count - 1) 'base 0
For i = 0 To UBound(a)
    v = CStr(r(i + 1))
    If IsNumeric(v) Then a(i) = CDbl(v) Else a(i) = v
Next
tri a, 0, i - 1
Xconcat = Join(a, Chr(1))
End Function

Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub