avec des dicos ?
en ajoutant la bibliotheque "microsoft scripting runtime"
un truc du genre:
Sub fgdh()
Dim dico_Col1 As New Scripting.Dictionary, dico_Col2 As New Scripting.Dictionary, dico_Col3 As New Scripting.Dictionary
col1 = 1
col2 = 2
col3 = 3
'remplissage des 3 dicos
For i = 1 To Cells(65536, col1).End(xlUp).Row
dico_Col1(CStr(Cells(i, col1).Value)) = 1
Next i
For i = 1 To Cells(65536, col2).End(xlUp).Row
dico_Col2(CStr(Cells(i, col2).Value)) = 1
Next i
For i = 1 To Cells(65536, col3).End(xlUp).Row
dico_Col3(CStr(Cells(i, col3).Value)) = 1
Next i
'test sur chaque cellule
For i = 1 To Cells(65536, col1).End(xlUp).Row
If dico_Col1.Exists(CStr(Cells(i, col1).Value)) And dico_Col2.Exists(CStr(Cells(i, col1).Value)) And dico_Col3.Exists(CStr(Cells(i, col1).Value)) Then
Cells(i, col1).Interior.Color = vbGrayText
End If
Next i
For i = 1 To Cells(65536, col2).End(xlUp).Row
If dico_Col1.Exists(CStr(Cells(i, col2).Value)) And dico_Col2.Exists(CStr(Cells(i, col2).Value)) And dico_Col3.Exists(CStr(Cells(i, col2).Value)) Then
Cells(i, col2).Interior.Color = vbGrayText
End If
Next i
For i = 1 To Cells(65536, col3).End(xlUp).Row
If dico_Col1.Exists(CStr(Cells(i, col3).Value)) And dico_Col2.Exists(CStr(Cells(i, col3).Value)) And dico_Col3.Exists(CStr(Cells(i, col3).Value)) Then
Cells(i, col3).Interior.Color = vbGrayText
End If
Next i
End Sub