Extractions avec ou sans accents en VBA Excel

Pour partager cette vidéo sur les réseaux sociaux ou sur un site, voici son url :


Sujets que vous pourriez aussi aimer :


Extractions avec ou sans accents

Avec cette nouvelle astuce VBA Excel, nous allons démontrer comment réaliser des recherches capables de fonctionner même lorsque les accentuations ne sont pas respectées. Pour appuyer les démonstrations, nous proposons de récupérer un classeur Excel offrant quelques travaux déjà bien avancés.

• Télécharger le classeur ignorer-accents.xlsm en cliquant sur ce lien,
• Double cliquer sur le fichier réceptionné pour l'ouvrir dans Excel,

Nous découvrons un classeur constitué de deux feuilles. C'est la seconde, nommée cherche, qui est active par défaut. La première, nommée bdd, héberge une base de données des activités de sorties.

• Sur la feuille cherche, déployer la liste déroulante placée en cellule G4,
• Puis, cliquer sur la deuxième proposition (Hôtel),

Comme vous pouvez l'apprécier, ce sont tous les hôtels, issus de la feuille bdd qui sont instantanément rapatriés dans la feuille cherche. Par contre, avec la liste déroulante en G4, si vous optez pour le premier choix, soit hotel sans accents, la grille d'extraction se vide. Plus aucun résultat concordant n'est trouvé, pour une simple différence d'accents. Il en va de même si vous cherchez à extraire les activités pour 07-Ardeche au lieu de 07-Ardèche. Nous souhaitons corriger ce problème pour permettre plus de largesse à l'utilisateur.

Le code d'extraction
Nous proposons maintenant de survoler le code VBA existant.

• Réaliser le raccourci clavier ALT + F11 pour basculer dans l'éditeur VBA Excel,
• Dans l'explorateur sur la gauche, double cliquer sur l'élément Feuil2(cherche),

Ainsi, nous atteignons le code VBA associé à cette feuille du classeur. C'est une procédure événementielle (Worksheet_Change) qui est destinée à déclencher son code lorsqu'une modification de valeur est détectée dans n'importe quelle cellule de la feuille. Mais pour optimiser les ressources, nous limitons son champ d'action à la cellule G4, celle de la liste déroulante :

If Target.Address = "$G$4" Then

Nous parcourons ensuite toutes les lignes de la base de données sur la première feuille :

While feuille1.Cells(compteur1, 2).Value <> ""

Nous portons ensuite l'analyse sur les champs de l'activité et du département :

If(feuille1.Cells(compteur1, 4).Value = cherche Or feuille1.Cells(compteur1, 5).Value = cherche)

Pour la ligne en cours d'étude sur la feuille bdd, si l'une ou l'autre cellule porte la valeur cherchée, inscrite en cellule G4 de la deuxième feuille, alors nous prélevons la ligne en cours pour l'importer dans la feuille cherche, à la suite des précédentes (compteur2) :

feuille2.Range("B" & compteur2 & ":E" & compteur2).Value = feuille1.Range("C" & compteur1 & ":F" & compteur1).Value

Mais à ce stade, il s'agit de comparaisons strictes entre les cellules.

La gestion des accents
L'idée consiste à appliquer une fonction de traitement des accents sur les données comparées. Cette fonction existe déjà et son code est amorcé.

• Dans l'explorateur sur la gauche, double cliquer sur l'élément Module1,

Nous y trouvons la présence d'une fonction nommée sansAccents :

Function sansAccents(contenu As String) As String
Dim tabAvec() As String: Dim tabSans() As String

tabAvec = Split("À, Á, Â, Ã, Ä, Å, Ç, È, É, Ê, Ë, Ì, Í, Î, Ï, ?', Ó, Ô, Õ, Ö,Ù, Ú, Û, Ü, Ý, à, á, â, ã, ä, å, ç, è, é, ê, ë, ì, í, î, ï, ð, ò, ó, ô, õ, ö, ù,ú, û, ü, ý, ÿ",   ", ")
tabSans = Split("A, A, A, A, A, A, C, E, E, E, E, I, I, I, I, O, O, O, O, O,U, U, U, U, Y, a, a, a, a, a, a, c, e, e, e, e, i, i, i, i, o, o, o, o, o, o, u,u, u, u, y, y",   ", ")

End Function

Elle se contente pour l'instant d'initialiser deux tableaux de variables. Le premier représente toutes les lettres accentuées. Dans le même ordre, le second représente toutes ces mêmes lettres mais sans accents. C'est grâce à eux que nous allons pouvoir remplacer les accents pour réaliser des recherches plus efficaces.

Parcourir le tableau des accents
Cette fonction doit parcourir le tableau des accents pour les rechercher tous et individuellement dans la chaîne qui lui est passée en paramètre (variable contenu). Pour cela, nous devons commencer par déclarer une variable de boucle.

• Dans la partie déclarative de la fonction, ajouter la ligne suivante :

Function sansAccents(contenu As String) As String
Dim tabAvec() As String: Dim tabSans() As String
Dim i As Byte
...

Grâce à elle, nous allons maintenant pouvoir construire une boucle dont la vocation est de parcourir tous les accents du premier tableau de variables. Rappelons-le, les deux tableaux ont exactement la même taille puisque le second énumère toutes les mêmes lettres que le premier, mais sans accents.

• Après l'initialisation des deux tableaux de variables, créer la boucle suivante :

...
sansAccents = contenu
For i = 0 To UBound(tabAvec)

Next i
...

C'est la fonction UBound qui renvoie la dimension d'un tableau. Nous parcourons donc tous ses éléments du premier (0) au dernier (UBound).

Remplacer tous les accents
Maintenant, à chaque passage dans cette boucle, il ne nous reste plus qu'à remplacer tous les accents trouvés dans la chaîne passée en paramètre de la fonction.

• Dans les bornes de la boucle, ajouter l'instruction VBA suivante :

...
sansAccents = Replace(sansAccents, tabAvec(i), tabSans(i))
...

Nous appliquons la fonction Replace sur la chaîne passée en paramètre (contenu). Nous y cherchons l'accent en cours d'analyse par la boucle (tabAvec(i)). S'il est trouvé, nous le remplaçons par son homologue sans accent (tabSans(i)).

Comparer sans accents
Pour aboutir la solution, cette fonction doit désormais être exploitée. Dans la procédure événementielle de la seconde feuille du classeur, elle doit être appelée à chaque passage sur chaque donnée à comparer avec une autre.

• Dans l'explorateur de projet, double cliquer sur l'élément Feuil2(cherche),
• Dans la procédure événementielle, adapter le double test comme suit :

...
While feuille1.Cells(compteur1, 2).Value <> ""
If (sansAccents(feuille1.Cells(compteur1, 4).Value) = sansAccents(cherche) Or sansAccents(feuille1.Cells(compteur1, 5).Value) = sansAccents(cherche)) Then
feuille2.Range("B" & compteur2 & ":E" & compteur2).Value = feuille1.Range("C" & compteur1 & ":F" & compteur1).Value
compteur2 = compteur2 + 1
...

• Enregistrer les modifications (CTRL + S) et revenir sur la seconde feuille du classeur (ALT + Tab),
• Avec la liste déroulante en G4, choisir de nouveau la deuxième proposition (Hôtel),

Comme tout à l'heure, tous les hôtels sont automatiquement extraits. Mais si vous optez maintenant pour la première proposition (Hotel), malgré l'absence de l'accent, c'est strictement la même importation qui est désormais réalisée. Il en va de même avec les autres termes, qu'ils portent ou non des accents.