Sub doublonLigne()
'--- Déclaration des variables ---'
Dim t1, t2
Dim d1 As Object, d2 As Object
Dim w As Workbook
Dim f1 As Worksheet, f2 As Worksheet
'--- Enregistrement du classeur et des feuilles ---'
Set w = ThisWorkbook
Set f1 = w.Sheets(1): Set f2 = w.Sheets(2)
'--- Remise à zéro du surlignage ---'
f1.Cells.Interior.Pattern = xlNone
f2.Cells.Interior.Pattern = xlNone
'--- Enregistrement des tableaux ---'
t1 = f1.[a1].CurrentRegion: t2 = f2.[a2].CurrentRegion
'--- Création des dictionnaires ---'
Set d1 = CreateObject("Scripting.Dictionary"): Set d2 = CreateObject("Scripting.Dictionary")
'--- Appel des procédures d'alimentation des dictionnaires ---'
Call alimentationDico(d1, t1)
Call alimentationDico(d2, t2)
'--- Appel de la procédure de comparaison des dictionnaires ---'
Call comparaisonLigne(f1, f2, d1, d2)
End Sub
Sub alimentationDico(d As Object, t)
Dim i&, j As Byte
Dim n$
'--- Boucle sur le tableau pour enregistrement du texte ---'
For i = LBound(t) To UBound(t)
n = ""
For j = LBound(t, 2) To UBound(t, 2)
n = n & t(i, j)
Next j
'--- La clef du dictionnaire est le texte collé des 10 colonnes pour chaque ligne, l'item est le numéro de ligne ---'
d(n) = i
Next i
End Sub
Sub comparaisonLigne(f1 As Worksheet, f2 As Worksheet, d1 As Object, d2 As Object)
Dim k
Dim i&
'--- Boucle de chacune des clefs du dictionnaire 1 ---'
For Each k In d1.Keys
'--- Si la clef se trouve dans le dictionnaire 2, surlignage de la ligne dans les deux feuilles ---'
If d2.exists(k) Then
f1.Cells(d1(k), 1).Resize(, 10).Interior.Color = 65535
f2.Cells(d2(k), 1).Resize(, 10).Interior.Color = 65535
End If
Next k
End Sub