Option Compare Text
Sub F1_nonF2()
Application.ScreenUpdating = False
Set f1 = Sheets("F1")
Set f2 = Sheets("F2")
'on définit a et b comme étant les 2 tableaux BD1 et BD2'
a = f2.Range("A1").CurrentRegion.Value
b = f1.Range("A1").CurrentRegion.Value
Set mondico1 = CreateObject("Scripting.Dictionary")
Set mondico2 = CreateObject("Scripting.Dictionary")
'On crée un dictionnaire de données sur la ligne i et la colonne 1'
For i = 2 To UBound(a): mondico1(sansAccent(a(i, 2))) = "": Next i
ligne = 1
Dim c
ReDim c(1 To Application.Max(UBound(a), UBound(b)), 1 To UBound(a, 2))
For i = 2 To UBound(b)
If Not mondico1.Exists(sansAccent(b(i, 2))) And Not mondico2.Exists(sansAccent(b(i, 2))) Then
mondico2(sansAccent(b(i, 2))) = ""
For K = 1 To UBound(b, 2): c(ligne, K) = b(i, K): Next K
ligne = ligne + 1
End If
Next
Sheets("Sorties").[A2].Resize(UBound(a, 1), UBound(a, 2)) = c
End Sub
Function sansAccent(chaine)
codeA = "ÉÈÊËÔéèêëàçùôûïî"
codeB = "EEEEOeeeeacuouii"
temp = chaine
For i = 1 To Len(temp)
p = InStr(codeA, Mid(temp, i, 1))
If p > 0 Then Mid(temp, i, 1) = Mid(codeB, p, 1)
Next
sansAccent = temp
End Function