Substituer des sous-chaînes

Je vous présente une fonction polyvalente écrite en VBA qui permet de remplacer une ou plusieurs sous-chaînes en tenant compte ou non de la casse des caractères.

La fonction

Public Function Substituer(ByVal Chaine As String, ParamArray Substitutions() As Variant) As String
'Remplacer une ou plusieurs sous-chaines
'Philben - v1.0 - free to use
  Dim i As Long, a As Long, b As Long
   Dim f As String, r As String
   Dim TypeComparaison As VbCompareMethod   '0 = vbBinaryCompare par défaut

   If Len(Chaine) > 0 Then
      For i = 0 To UBound(Substitutions) Step 2
         If VarType(Substitutions(i)) = vbString Then
            f = Substitutions(i)
            r = Substitutions(i + 1)
            'si la longueur de la sous-chaine recherchée est > à la chaine de remplacement => boucle de substitution
           If Len(f) > Len(r) Then
               a = Len(Chaine)
               Do
                  b = a
                  If InStr(1, Chaine, f, TypeComparaison) > 0 Then
                     Chaine = Replace(Chaine, f, r, , , TypeComparaison)
                     a = Len(Chaine)
                  End If
               Loop Until a = b
               'sinon, substitution unique
           ElseIf InStr(1, Chaine, f, TypeComparaison) > 0 Then
               Chaine = Replace(Chaine, f, r, , , TypeComparaison)
            End If
         Else   'nouveau type de comparaison
           TypeComparaison = IIf(Substitutions(i) <> 0, vbTextCompare, vbBinaryCompare)
            i = i - 1   'Ajustement car step 2 de la boucle
        End If
      Next i
   End If
 
   Substituer = Chaine
End Function

Exemple d’utilisation
Recopier la ligne suivante dans la fenêtre ‘Exécution’ de l’éditeur Visual Basic (F11) puis appuyer sur ‘Entrée’ pour l’exécuter.

? Substituer("MA_Chaîne_______A_Corrigé","_"," ","  "," "," A "," à ","î","i","é","er",true,"ma","La")
'Résultat:La Chaine à Corriger

Explications
Le premier paramètre de la fonction contient la chaine à modifier.
Le deuxième paramètre est un peu particulier car il s’agit d’une suite de paramètres qui sera interprétée comme un tableau de variants. Ce tableau contient l’ensemble des substitutions à réaliser (couple chaine recherchée/chaine de remplacement) et éventuellement un booléen qui indique le type de comparaison (binaire ou textuelle) pour les remplacements suivants.

Par défaut, la fonction effectue une comparaison binaire pour rechercher et remplacer les sous-chaines c’est à dire qu’elle est sensible à la casse des caractères.

Dans notre exemple, on va tout d’abord substituer le caractère ‘_’ par un espace (‘_’,’ ‘) puis réduire le nombre d’espaces contigus en un (‘ ‘,’ ‘). A ce stade on obtient :

? Substituer("MA_Chaîne_______A_Corrigé","_"," ","  "," ")
'Résultat:MA Chaîne A Corrigé

Lorsque la chaine de remplacement est plus courte que la chaine recherchée, la fonction réalise une boucle de réduction. Par exemple, 5 espaces contigus seront réduits en un même si la chaine recherchée n’est que de deux espaces.

L’étape suivante (‘ A ‘,’ à ‘) recherche la lettre A en majuscule entourée d’espaces, on remplace ensuite le i accentué par son équivalent sans accent (‘î’,’i’) puis le ‘é’ par ‘er’.

L’étape suivante (True ou tout chiffre différent de 0) indique à la fonction que l’on souhaite réaliser maintenant des comparaisons textuelles (vbTextCompare) donc insensibles à la casse des caractères. L’étape suivante (‘ma’,’La’) remplacera donc le texte ‘ma’ par ‘la’ quel que soit la casse des caractères.

On pourrait ajouter d’autres remplacements et revenir aussi à une comparaison binaire (False ou le chiffre 0).

Remarque
Dans le cas d’une réduction de chaine, on réalise une boucle qui ne s’arrête que si la longueur de la chaine est inchangée (…Loop Until a = b) après la fonction Replace(). Cette méthode est moins efficace que :

While InStr(1, Chaine, f, TypeComparaison) > 0
      Chaine = Replace(Chaine, f, r, , , TypeComparaison)
Wend

mais on risque d’entrer dans une boucle infinie si on souhaite réduire par exemple ‘oe’ en ‘Å’’ avec une comparaison textuelle… En effet, cette ligature est interprétée comme équivalente à ‘oe’ :

? InStr(1, "oe", "Å’", vbTextCompare)

Access retourne la valeur 1 bien que l’on s’attend à obtenir 0…

Pour le fun !
Une autre solution pour réduire les espaces :

'---
Substituer("a      b", " ", vbVerticalTab & vbFormFeed, vbFormFeed & vbVerticalTab, vbNullString, vbVerticalTab & vbFormFeed, " ")
'---

Ce type de méthode est parfois utilisé dans les requêtes SQL pour s’affranchir d’une fonction personnelle dans la requête :

SELECT REPLACE(REPLACE(REPLACE([Ma Colonne], " ", " " & Chr(0)), Chr(0) & " ", ""), Chr(0), "") AS TEST FROM ...

@+

Philippe

Laisser un commentaire