Recherche avec accent

On recherche un mot orthographié avec des accentuations différentes.

Solution rapide avec Find (0,04 s pour 25.000 mots)

On remplace tous les caractères succeptibles d'avoir des accents par *

Par exemple: etuve --> *t*v*

Private Sub B_ok_Click()
   Me.ListBox1.Clear
   Set c = Range("A:A").Find(Rmp(Me.TextBox1), LookIn:=xlValues)
  If Not c Is Nothing Then
     premier = c.Address
     i = 0
     Do
       If sansAccent(Me.TextBox1) = sansAccent(c) Then
          Me.ListBox1.AddItem
          Me.ListBox1.List(i, 0) = c.Value
          i = i + 1
       End If
       Set c = Range("A:A").FindNext(c)
     Loop While Not c Is Nothing And c.Address <> premier
  End If
End Sub

Function Rmp(chaine)
   codeA = "ÉÈÊËÔéèêëàçùôûïîeouci"
   temp = chaine
   For i = 1 To Len(temp)
      p = InStr(codeA, Mid(temp, i, 1))
      If p > 0 Then Mid(temp, i, 1) = "*"
   Next
   Rmp = temp
End Function

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

Recherche séquentielle (0,75s pour 25.000 mots )

Private Sub CommandButton1_Click()
   t = Timer()
   Me.ListBox1.Clear
   i = 0
   For Each c In Range([A2], [A65000].End(xlUp))
     If sansAccent(c) = sansAccent(Me.TextBox1) Then
        Me.ListBox1.AddItem
        Me.ListBox1.List(i, 0) = c
        i = i + 1
     End If
   Next c
   MsgBox Timer() - t
End Sub