Function SansAccent$(chaine$)
Dim codeA$, codeB$, i%, p%
codeA = "àáâãäåòóôõöøèéêëìíîïùúûüÿñç"
codeB = "aaaaaaooooooeeeeiiiiuuuuync"
For i = 1 To Len(chaine)
p = InStr(codeA, Mid(chaine, i, 1))
If p Then Mid(chaine, i, 1) = Mid(codeB, p, 1)
Next
SansAccent = chaine
End Function
Sub Liste()
Dim tablo, d As Object, i&
tablo = [B5].CurrentRegion.Resize(, 4) 'matrice, plus rapide
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tablo)
d(SansAccent(LCase(tablo(i, 2)))) = tablo(i, 1)
Next
For i = 1 To UBound(tablo)
tablo(i, 4) = d(SansAccent(LCase(tablo(i, 3))))
Next
With Feuil1 'CodeName, à adapter
If .FilterMode Then .ShowAllData 'si la feuille est filtrée
.[E5].Resize(UBound(tablo)) = Application.Index(tablo, , 4)
End With
End Sub