Remplacer les caractères accentués d’une chaîne

Publié le par

Lors d’une recherche de sous-chaine, il est parfois nécessaire de substituer les lettres accentuées par leurs équivalents sans accent.
En effet, le moteur Jet des bases de données Access est insensible à la casse des caractères mais ne fait pas le lien entre un caractère accentué et son équivalent.
La FAQ propose déjà deux fonctions ayant le même objectif, mais voici une troisième voie qui se caractérise par sa vitesse d’exécution et la possibilité ou non de conserver la casse des caractères de la chaine initiale.

La fonction en VBA

Public Function SupprimerAccents(ByVal Chaine As String, Optional ByVal ConserverCasseChaine As Boolean = False) As String
'Substituer les caractères accentués et conserver ou non la casse des caractères de la chaine
'La fonction est plus rapide :
'   - si on ne conserve pas la casse des caractères de la chaine (par défaut)
'   - si les deux constantes (cMajAvecAccent, cMajSansAccent) sont réduites au strict nécessaire
  Const cMajAvecAccent As String = "ÀÁÂÃÄÅÇÐÈÉÊËÌÍÎÏÑÒÓÔÕÖŠÙÚÛÜÝŸŽ"   'Caractères à substituer (en MAJUSCULE)
  Const cMajSansAccent As String = "AAAAAACDEEEEIIIINOOOOOSUUUUYYZ"   'Caractères de substitution (en MAJUSCULE)
  Dim f As String, i As Long
 
   If Not ConserverCasseChaine Then
      Chaine = UCase$(Chaine)
      For i = 1 To Len(cMajAvecAccent)
         f = Mid$(cMajAvecAccent, i, 1)
         If InStr(1, Chaine, f, vbBinaryCompare) > 0 Then
            Chaine = Replace(Chaine, f, Mid$(cMajSansAccent, i, 1), , , vbBinaryCompare)
         End If
      Next i
   Else
      For i = 1 To Len(cMajAvecAccent)
         f = Mid$(cMajAvecAccent, i, 1)
         If InStr(1, Chaine, f, vbBinaryCompare) > 0 Then
            Chaine = Replace(Chaine, f, Mid$(cMajSansAccent, i, 1), , , vbBinaryCompare)
         End If
         If InStr(1, Chaine, LCase$(f), vbBinaryCompare) > 0 Then
            Chaine = Replace(Chaine, LCase$(f), LCase$(Mid$(cMajSansAccent, i, 1)), , , vbBinaryCompare)
         End If
      Next i
   End If
 
   SupprimerAccents = Chaine
End Function

La fonction est d’autant plus rapide si on ne conserve pas la casse de la chaine et si on réduit les caractères accentués recherchés au strict nécessaire.
Il est parfois utile de conserver la casse des caractères de la chaine dans une requête d’insertion ou de mise à jour ou si l’on souhaite faire une recherche sur la casse des caractères seulement.

Suivant les cas, il est performant de tester avant de rentrer dans les boucles si la longueur de la chaine est supérieure à zéro et/ou dans le cas où l’on souhaite conserver la casse, de faire un screening avant les deux recherches InStr().

Exemple d’utilisation
Dans la fenêtre Exécution du VBE :

'Attendu: HEOOODFGFDGOOEEFDG
?supprimeraccents("hêÒÓôdfgfdgÕÖÈÉfdg")

'Attendu: heOOodfgfdgOOEEfdg  
?supprimeraccents("hêÒÓôdfgfdgÕÖÈÉfdg",True)

@+

Philippe

Une réflexion au sujet de « Remplacer les caractères accentués d’une chaîne »

Laisser un commentaire