Extraire un token d’une chaîne de caractères

Publié le par

Il est parfois nécessaire d’extraire une sous-chaîne délimitée par un séparateur. Je vous présente ici deux fonctions polyvalentes écrites en VBA.

Cahier des charges
De la chaîne « a-b-c-d-e-f » on souhaite extraire la sous-chaîne x délimitée par le séparateur « -« .
Le premier token correspond à « a », le troisième sera « c » et le dernier « f ».
Notre fonction doit pouvoir gérer les cas particuliers suivants :

  • Si Chaîne = « a » le token n°1 sera « a »
  • Si Chaîne = « a- » le token n°1 sera « a » et le token n°2 sera une chaîne vide
  • Si Chaîne = « – » les tokens seront vides
  • Si Chaîne = «  » la fonction retourne une chaîne vide
  • Si le numéro de token demandé est supérieur au nombre de token, la fonction retourne une chaîne vide

De plus, elle doit pouvoir gérer un séparateur composé d’un ou plusieurs caractères et proposer une comparaison binaire ou textuelle (insensible à la casse des caractères) sur le séparateur.

Première solution : Split()
Intuitivement, la première idée est d’utiliser la fonction VBA Split() qui découpe la chaîne initiale en fonction du séparateur.

Public Function TokenBySplit(ByVal Texte As String, ByVal Separateur As String, ByVal Numero As Long, Optional ByVal TypeComparaison As VbCompareMethod = vbBinaryCompare) As String
'Retourne le token spécifié par son numéro
'Auteur : Philben - v1.0
'Exemple : TokenBySplit("a-b-c","-",2) -> b
  Dim a() As String
   If Texte <> vbNullString And Numero > 0 Then
      a = Split(Texte, Separateur, Numero + 1, TypeComparaison)
      If UBound(a) >= Numero - 1 Then
         TokenBySplit = a(Numero - 1)
      ElseIf Numero = 1 Then
         TokenBySplit = Texte
      End If
   End If
End Function

Deuxième solution
L’idée était de s’affranchir de Split() qui n’est pas reconnu pour sa vitesse d’exécution…

Public Function Token(ByVal Texte As String, ByVal Separateur As String, ByVal Numero As Long, Optional ByVal TypeComparaison As VbCompareMethod = vbBinaryCompare) As String
'Retourne le token spécifié par son numéro
'Auteur : Philben - v1.01
'Exemple : Token("a-b-c","-",2) -> b
  Dim Tok As String
   Dim x As Long, y As Long
 
   Select Case Numero
   Case Is > 1
      x = InStr(1, Replace(texte, Separateur, vbNullString, 1, Numero - 2, TypeComparaison), Separateur, TypeComparaison)
      If x > 0 Then
         x = x + Len(Separateur) * (Numero - 1)
         y = InStr(x, texte, Separateur, TypeComparaison)
         If y > 0 Then
            Tok = Mid$(texte, x, y - x)
         Else
            Tok = Mid$(texte, x)
         End If
      End If
   Case 1
      x = InStr(1, texte, Separateur, TypeComparaison)
      If x > 0 Then
         Tok = Left$(texte, x - 1)
      Else
         Tok = texte
      End If
   Case -1
      x = InStrRev(texte, Separateur, -1, TypeComparaison)
      If x > 0 Then
         Tok = Mid$(texte, x + Len(Separateur))
      Else
         Tok = texte
      End If
   End Select
   Token = Tok
End Function

Le principe est de supprimer par Replace() les séparateurs qui précèdent celui que l’on recherche par InStr().

Si on a besoin de rechercher le dernier token sans connaître sa position, la fonction le permet en passant -1 dans le numéro du token recherché.

Qualité
Pour vérifier que les fonctions répondent bien au cahier des charges, la fonction suivante réalise 30 tests.
Certains tests ne sont pas réalisés pour TokenBySplit() car elle ne gère pas le cas où le Numéro du token passé en paramètre est égal à -1 (recherche du dernier token sans connaître sa position).

Les résultats s’affichent dans la fenêtre d’exécution de VBE.

Public Function testToken()
'Choix de la fonction à tester (True ou False)
  Const TestTokenBySplit As Boolean = False
 
   Dim a As Variant
   Dim r As String, p As String
   Dim i As Long, baseNumTest As Long
   Dim bNoTest As Boolean
 
   Debug.Print "*** Test de la fonction" & IIf(TestTokenBySplit, " TokenBySplit() ", " Token() ") & "***"
   Debug.Print "Test n°", "Résultat", "Attendu", "Obtenu", "Paramètres"
 
   a = Array("", "-", -1, vbBinaryCompare, "", "", "-", 1, vbBinaryCompare, "", "", "-", 2, vbBinaryCompare, "", _
             "a", "-", -1, vbBinaryCompare, "a", "a", "-", 1, vbBinaryCompare, "a", "a", "-", 2, vbBinaryCompare, "", _
             "a-", "-", -1, vbBinaryCompare, "", "a-", "-", 1, vbBinaryCompare, "a", "a-", "-", 2, vbBinaryCompare, "", _
             "aa-", "-", 1, vbBinaryCompare, "aa", "-", "-", -1, vbBinaryCompare, "", "-", "-", 1, vbBinaryCompare, "", _
             "-", "-", 2, vbBinaryCompare, "", "-b", "-", 1, vbBinaryCompare, "", "-b", "-", 2, vbBinaryCompare, "b", _
             "-b", "-", 3, vbBinaryCompare, "", "a-b-", "-", -1, vbBinaryCompare, "", "a-b-", "-", 2, vbBinaryCompare, "b", _
             "a-b-", "-", 3, vbBinaryCompare, "", "a-bb-", "-", 2, vbBinaryCompare, "bb", "a-b-c", "-", -1, vbBinaryCompare, "c", _
             "a-b-c", "-", 3, vbBinaryCompare, "c", "a-b-c", "-", 4, vbBinaryCompare, "", "a:/bb", ":/", 1, vbBinaryCompare, "a", _
             "a:/bb", ":/", 2, vbBinaryCompare, "bb", "a:/bb", ":/", -1, vbBinaryCompare, "bb", "aib", "I", 1, vbBinaryCompare, "aib", _
             "aib", "I", 2, vbBinaryCompare, "", "aib", "I", 1, vbTextCompare, "a", "aib", "I", 2, vbTextCompare, "b")
 
   baseNumTest = 1 - LBound(a)
   For i = LBound(a) To UBound(a) Step 5
      If TestTokenBySplit Then
         'TokenBySplit : on retire les tests si Numero = -1 (dernier token) car ne gère pas ce cas
        If a(i + 2) <> -1 Then
            r = TokenBySplit(a(i), a(i + 1), a(i + 2), a(i + 3))
            bNoTest = False
         Else
            bNoTest = True
         End If
      Else
         r = Token(a(i), a(i + 1), a(i + 2), a(i + 3))
      End If
 
      p = "'" & a(i) & "','" & a(i + 1) & "'," & a(i + 2) & "," & a(i + 3)
      If bNoTest = False Then
         If StrComp(r, a(i + 4), vbBinaryCompare) = 0 Then
            Debug.Print i / 5 + baseNumTest, "OK", "'" & a(i + 4) & "'", "'" & r & "'", p
         Else
            Debug.Print i / 5 + baseNumTest, "ERREUR", "'" & a(i + 4) & "'", "'" & r & "'", p
         End If
      Else
         Debug.Print i / 5 + baseNumTest, "NON TESTE", , , p
      End If
   Next i
   Debug.Print "*** Fin des tests ***"
End Function

Performances
La deuxième fonction est dans tous les cas plus performante que la première.
La différence peut aller jusqu’à 40% si on effectue une comparaison binaire sur le séparateur.

Exemples
Vous pouvez tester la fonction Token() avec ces exemples (coller les lignes dans la fenêtre Exécution de VBE, placer le curseur en fin d’une ligne à tester et valider par la touche « Entrée ») :

'Retourne l'extension du fichier : 'txt'
?token("c:\test\Fichiers\monfichier.txt",".",-1)

'Retourne le nom complet du fichier 'monfichier.txt'
?token("c:\test\Fichiers\monfichier.txt","\",-1)

'Retourne le nom du premier répertoire : 'test'
?token("c:\test\Fichiers\monfichier.txt","\",2)  

'Retourne le drive : 'c:'
?token("c:\test\Fichiers\monfichier.txt","\",1)

'Retourne la lettre du drive : 'c'
?token("c:\test\Fichiers\monfichier.txt",":\",1)

Rappel
Pour connaître le nombre d’occurrences du séparateur, vous pouvez utiliser la fonction suivante :

Public Function CompteOccurrences(ByVal Texte As String, ByVal Chaine As String, Optional ByVal TypeComparaison As VbCompareMethod = vbBinaryCompare) As Long
   If texte <> vbNullString Then CompteOccurrences = UBound(Split(texte, Chaine, -1, TypeComparaison))
End Function

Le nombre de tokens sera égal au nombre de séparateurs + 1

@+

Philippe

Laisser un commentaire