Extraction d’une sous-chaîne délimitée par deux séparateurs différents

Publié le par

Un camarade de jeu souhaitait extraire d’une table, une chaîne de caractères délimitée par deux séparateurs (Token in english!) via une requête SQL.
Deux solutions sont présentées : L’une par utilisation d’une fonction personnelle en VBA (UDF : User-Defined-Function) et l’autre sans UDF via des fonctions standards VBA.

Cahier des charges

  • La table contient 100 000 lignes : Va falloir être performant sur le coup !
  • La colonne de texte ne contient aucun NULL : Tant mieux, une source de problèmes en moins…
  • Les séparateurs du token sont toujours présents : Nickel, on évite des tests supplémentaires…
  • Il peut y avoir plus de deux séparateurs dans le texte, dans ce cas, prendre la sous-chaine entourée par les séparateurs extrêmes : Il faudra trouver une méthode pour faire abstraction des séparateurs parasites…
  • Les séparateurs sont ‘[‘ et ‘]’ : Bien, on va pouvoir faire des comparaisons binaires qui sont les plus performantes…
  • Les deux délimiteurs peuvent être côte à côte : Ok, faudra vérifier ce cas particulier avec l’algorithme.
  • Le nombre de caractères dans le texte est variable ainsi que la position des séparateurs : Ben, Il faudra les rechercher…
  • Version 2007 d’Access : Reconnaît les fonctions VBA ‘modernes’

Exemples suite au cahier des charges

'a[SC]bc' -> 'SC'
'[SC]'    -> 'SC'
'ab[S[]]' -> 'S[]'
'ab[]cd'  -> ''

 
Création de la table et des lignes
Cette fonction créée la table tToken et 100 000 lignes. Peut prendre plusieurs secondes selon le système.
La table possède une colonne LenToken qui permettra de vérifier, via une requête, la qualité des résultats.

Pour l’utiliser, copier l’ensemble du code dans un module VBA, placer le focus dans la fonction ‘CreationTableToken()’ puis appuyer sur ‘F5′ pour l’exécuter.

Public Function CreationTableToken()
   With DoCmd
      .SetWarnings False
      .RunSQL "CREATE TABLE tToken (Texte CHAR NOT NULL, LenToken LONG);"
      .SetWarnings True
   End With
   GenereTokens
 
   MsgBox "Création terminée"
End Function
 
Private Function GenereTokens()
   Const clMaxLignes As Long = 100000
   Const cHorsTokenASCII As Long = 95
   Const cTokenASCII As Long = 84
   Const cCrochetGauche As String = "["
   Const cCrochetDroite As String = "]"
 
   Dim odb As DAO.Database
   Dim ors As DAO.Recordset
   Dim Texte As String
   Dim i As Long, l As Long, x As Long, y As Long
 
   Set odb = CurrentDb
   Set ors = odb.OpenRecordset("tToken", dbOpenDynaset)
   Randomize
 
   With ors
      For i = 1 To clMaxLignes
         'construction du texte
        l = Int(Rnd() * 254) + 2   'longueur variable du texte : 2 à 255
        Do
            x = Int(l * Rnd()) + 1
            y = Int(l * Rnd()) + 1
         Loop Until x  x + 1 Then
            While Rnd() < 0.5
               Mid$(Texte, Int((y - x - 1) * Rnd()) + x + 1, 1) = IIf(Rnd()  1 Then
            While Rnd() < 0.5
               Mid$(Texte, Int((x - 1) * Rnd()) + 1, 1) = cCrochetDroite
            Wend
         End If
         If y < l Then
            While Rnd() < 0.5
               Mid$(Texte, Int((l - y - 1) * Rnd()) + y + 1, 1) = cCrochetGauche
            Wend
         End If
         
         'Ajout de la ligne
        .AddNew
         !Texte = Texte
         !LenToken = y - x - 1
         .Update
         
      Next i
      .Close
   End With
 
   Set ors = Nothing
   Set odb = Nothing
End Function

 
La trousse à outils VBA
Rapide inventaire des fonctions VBA qui permettent d’extraire une sous-chaîne :

  • Left(Texte, Longueur) et Right(…) : Permettent d’extraire la partie gauche ou droite d’un texte.
  • Mid(Texte, Début, Longueur) : Permet d’extraire une partie quelconque d’un texte
  • Split(Texte, séparateur,…) : Retourne dans un tableau de base zéro le texte scindé par le séparateur .
  • Replace(Texte, Recherche, Remplacement,…) : Ce n’est pas son usage habituel mais si on connait le texte à retirer, on peut le remplacer par une chaîne vide et ne conserver que la sous-chaîne désirée…

La fonction Len(…) permet de compter les caractères d’une chaîne.

Les fonctions VBA pour déterminer la position d’une sous-chaîne :

  • InStr([Début],Texte, Recherche,…) : Renvoie la position de la première occurrence de Recherche à partir du début du Texte
  • InStrRev(Texte, Recherche,…) : Renvoie la première occurrence de Recherche à partir de la fin du Texte.

Remarque
Certaines fonctions existent avec $ en suffixe de leur nom (Left$(),…) : Ceci veut dire qu’elles vont retourner une variable de type String (chaîne de caractères) et non un Variant qui peut être NULL ou typé (String, Date).

Liste des fonctions qui retournent un type String (parfois, elles ont un argument String au lieu de Variant) :

Chr$(),     ChrB$(),  ChrW$(),   Command$(), CurDir$(), Date$(),   Dir$(),
Environ$(), Error$(), Format$(), Hex$(),     Input$(),  InputB$(), LCase$(),
Left$(),    LeftB$(), LTrim$(),  Mid$(),     MidB$(),   Oct$(),    Right$(),
RightB$(),  RTrim$(), Space$(),  Str$(),     String$(), Time$(),   Trim$(),
UCase$()

 
Comment choisir entre $ ou non ?
Si on souhaite propager un NULL ou retourner un variant de type Date (fonction Time(), Date()) il faudra donc utiliser la version sans $.
Par contre, si on recherche la performance ET que l’on ne passe pas un NULL à la fonction$ (une erreur est levée dans ce cas) ET que l’on souhaite récupérer une variable de type caractère, il est préférable d’utiliser les fonctions avec $. Le gain de rapidité de fonction$() peut atteindre 40% par rapport à son équivalent !

Construction de la fonction VBA
D’après le cahier des charges, la colonne de la table ne contient pas de NULL, donc on peut écrire une fonction qui aura en paramètre un type String et retournera aussi un type String (performance meilleure).
Dans ce cas, on pourra utiliser les fonctions équivalentes Fonction$() pour un gain de performance.

On ne pourra pas utiliser Split() car il faut seulement prendre les séparateurs extrêmes si il en existe plusieurs. Split() couperait la chaîne autant de fois qu’il y a de séparateurs…
Il faudra donc utiliser une fois InStr() pour trouver le premier séparateur et InStrRev() pour positionner le dernier.

Les séparateurs peuvent être n’importe où dans le texte, la seule fonction qui permette de récupérer une sous-chaîne dans ce cas est Mid().

La fonction ‘spécifique’ à la demande est :

Public Function MyToken(ByVal Texte As String) As String
    Dim x As Long
    x = InStr(1, Texte, "[", vbBinaryCompare) + 1
    MyToken = Mid$(Texte, x, InStrRev(Texte, "]", -1, vbBinaryCompare) - x)
End Function

On affecte à la variable x la position du séparateur ‘[‘ le plus à gauche dans la chaîne. On lui ajoute 1 car ceci évite deux additions par la suite.
On remarque que InStr est utilisé ici dans sa version ‘longue’ (InStr(Depart, Texte, Recherche, Comparaison)) car on impose le type de comparaison. Si on ne l’impose pas on peut écrire InStr(Texte, Recherche).
La ligne suivante va extraire la sous-chaîne du Texte grâce à l’utilisation de la fonction Mid$().
Le deuxième argument (x) de Mid() détermine le point de départ de la sous-chaîne (position du séparateur gauche + 1).
Le troisième argument est une longueur, il nous faut donc déterminer la position du séparateur à droite de la sous-chaîne en utilisant InStrRev() et retrancher la position de départ (x).

Ci-dessous la même fonction mais plus polyvalente car gère l’absence d’un ou des séparateurs et le cas des chaînes vides :

Public Function MyToken2(ByVal Texte As String, ByVal SeparateurGauche As String, ByVal SeparateurDroite As String, Optional ByVal TypeComparaison As VbCompareMethod = vbBinaryCompare) As String
   Dim x As Long, y As Long
   If Texte <> vbNullString Then   'Test intéressant en terme de performance si de nombreux textes sont des chaînes vides
     x = InStr(1, Texte, SeparateurGauche, TypeComparaison)
      If x > 0 Then   'Test intéressant en terme de performance si le séparateur gauche n'est pas toujours présent
        y = InStrRev(Texte, SeparateurDroite, -1, TypeComparaison)
         'Test nécessaire sinon une erreur peut être levée
        If y > x Then MyToken2 = Mid$(Texte, x + 1, y - x - 1)
      End If
   End If
End Function

 
Enfin, la même fonction mais avec un argument et une valeur retournée de type Variant pour propager les NULL.

Public Function MyToken3(ByVal Texte As Variant, ByVal SeparateurGauche As String, ByVal SeparateurDroite As String, Optional ByVal TypeComparaison As VbCompareMethod = vbBinaryCompare) As Variant
   Dim x As Long, y As Long
   If Len(Nz(Texte,"")) > 0 Then   'Test nécessaire car InStr peut retourner Null et x est de type Long, InStrRev n'accepte pas un texte NULL
     x = InStr(1, Texte, SeparateurGauche, TypeComparaison)
      If x > 0 Then   'Test intéressant en terme de performance si le séparateur gauche n'est pas toujours présent
        y = InStrRev(Texte, SeparateurDroite, -1, TypeComparaison)
         'Test nécessaire sinon une erreur peut être levée
        If y > x Then MyToken3 = Mid(Texte, x + 1, y - x - 1)
      End If
   End If
End Function

On remarquera l’utilisation de la fonction Nz() qui retourne une valeur de notre choix si son argument est NULL.
Pour info, InStr() ne lève pas d’erreur si Texte est NULL contrairement à InStrRev…

et pour finir, la requête SQL via l’UDF MyToken():

SELECT Mytoken(texte) AS Token,
       ttoken.lentoken AS [Longueur théorique Token],
       Len([token]) AS [Longueur trouvée]
FROM   ttoken

 
Fonction directement dans le SQL
Le principe repose sur l’utilisation de la fonction Mid() et intuitivement on peut écrire le template de la fonction : Mid(Texte, InStr(), InStrRev() - InStr()).
Le reproche qui saute aux yeux est qu’on utilise deux fois la fonction InStr(). Bien que plus performante que InStrRev(), elle est tout de même plus consommatrice de temps CPU que Left(), Right() Mid().
Pour se débarrasser de ce deuxième InStr(), on peut s’appuyer sur une particularité de Mid(). En effet, le troisième paramètre de Mid() est optionnel. Si on ne renseigne pas la longueur de la chaîne retournée, Mid() retourne toute la chaîne à partir du point de départ.
Il faut donc dans le premier argument de Mid() passer une chaîne déjà limitée à droite.
Voici le nouveau template de notre fonction : Mid(LEFT(Texte,InStrRev()),InStr()).

Ensuite, il faut travailler sur la performance car on utilise tout de même 4 fonctions au lieu de 3 dans MyToken(). Dans le cas exposé ici, on utilisera les fonctions avec $ et on imposera la comparaison binaire.

La requête SQL est :

SELECT Mid$(LEFT$([texte],
            Instrrev([texte], "]", -1, 0) - 1),
            Instr(1, [texte], "[", 0) + 1)
       AS Token,
       ttoken.lentoken AS [Longueur théorique Token],
       Len([token]) AS [Longueur trouvée]
FROM ttoken

 
Performance et qualité
Avant de tester les performances, quitter normalement l’application Access puis la relancer sans ouvrir l’éditeur VBA pour ne pas pénaliser la requête avec l’UDF.

Les requêtes suivantes retournent les lignes dont la longueur théorique du token est différente de la longueur calculée (aucune ligne retournée normalement !).

La requête via l’UDF MyToken (plus performante a priori…)

SELECT Mytoken(texte) AS Token,
       ttoken.lentoken AS [Longueur théorique Token],
       Len(token) AS [Longueur trouvée]
FROM   ttoken
WHERE  Len(Mytoken(texte))  lentoken;

 
Et la même requête avec la fonction directement dans le code SQL :

SELECT Mid$(LEFT$([texte],
            Instrrev([texte], "]", -1, 0) - 1),
            Instr(1, [texte], "[", 0) + 1)
       AS Token,
       ttoken.lentoken AS [Longueur théorique Token],
       Len(token) AS [Longueur trouvée]
FROM   ttoken
WHERE  Len(Mid$(LEFT$([texte],
                Instrrev([texte], "]", -1, 0) - 1),
                Instr(1, [texte], "[", 0) + 1))  lentoken;

 
Lien
Voir ce billet pour extraire des token délimités par un seul séparateur.
 
@+

Philippe

Laisser un commentaire