Cellules en double dans des lignes différentes

'Hypothèse que les nombres dans A et E sont en ordre croissant.

Sub LignesEnDouble3()
   Dim Dict
   Dim ar
   Dim i As Integer, j As Integer
   Dim Temp As String
   
   ar = Sheets(1).Cells(1).CurrentRegion.Value
   Set Dict = CreateObject("Scripting.Dictionary")
   

   For i = 2 To UBound(ar, 1)
      For j = 1 To 3
         Temp = ar(i, j) & Chr(2) & ar(i, j + 1) & Chr(2) & ar(i, j + 2)
         If Not Dict.exists(Temp) Then
            Dict.Add Temp, i
         Else
            Sheets(1).Cells(i, 13) = "3 en commun"
         End If
      Next j
   Next i
End Sub


Sub LignesEnDouble4()
   Dim Dict
   Dim ar
   Dim i As Integer, j As Integer
   Dim Temp As String
   
   ar = Sheets(1).Cells(1).CurrentRegion.Value
   Set Dict = CreateObject("Scripting.Dictionary")
   

   For i = 2 To UBound(ar, 1)
      For j = 1 To 2
         Temp = ar(i, j) & Chr(2) & ar(i, j + 1) & Chr(2) & ar(i, j + 2) & ar(i, j + 3)
         If Not Dict.exists(Temp) Then
            Dict.Add Temp, i
         Else
            Sheets(1).Cells(i, 14) = "4 en commun"
         End If
      Next j
   Next i
End Sub

Function LigneCommune(xligne As Range, xtablo As Range, xNbrCommun) As Boolean
Dim tablo, ligne, i&, j&, k&, k2&, i1&, j1&, Nbr&, tot&, sauf&
Application.Volatile
ligne = xligne.Value
tablo = xtablo.Value
sauf = xligne.Row - xtablo.Row + 1
k2 = UBound(tablo)
i1 = UBound(tablo, 2): j1 = UBound(ligne, 2)
For k = 1 To k2
  If k <> sauf Then
    Nbr = 0
    i = 1: j = 1
    Do While i <= i1 And j <= j1
      Select Case Sgn(tablo(k, i) - ligne(1, j))
        Case -1
          i = i + 1
        Case 0
          Nbr = Nbr + 1
          i = i + 1: j = j + 1
        Case 1
          j = j + 1
      End Select
    Loop
    If Nbr = xNbrCommun Then
      LigneCommune = True
      Exit Function
    End If
  End If
Next k

End Function

Function LigneCommuneN(xligne As Range, xtablo As Range, xNbrCommun) As String
Dim tablo, ligne, i&, j&, k&, k2&, i1&, j1&, Nbr&, tot&, sauf&
Application.Volatile
ligne = xligne.Value
tablo = xtablo.Value
sauf = xligne.Row - xtablo.Row + 1
k2 = UBound(tablo)
i1 = UBound(tablo, 2): j1 = UBound(ligne, 2)
For k = 1 To k2
  If k <> sauf Then
    Nbr = 0
    i = 1: j = 1
    Do While i <= i1 And j <= j1
      Select Case Sgn(tablo(k, i) - ligne(1, j))
        Case -1
          i = i + 1
        Case 0
          Nbr = Nbr + 1
          i = i + 1: j = j + 1
        Case 1
          j = j + 1
      End Select
    Loop
    If Nbr = xNbrCommun Then
      LigneCommuneN = LigneCommuneN & "," & k + xtablo.Row - 1
    End If
  End If
Next k
If Left(LigneCommuneN, 1) = "," Then LigneCommuneN = Mid(LigneCommuneN, 2)
End Function