DominoArea.org [Archive]

Le but de cette fonction est de renvoyer un tableau à partir d'une chaine de caractères avec séparateurs ; exemple :
chaine="azerty,qsdfg,zorro, tintin,,milou"
donnerait
array(0)="azerty"
array(1)="qsdf"
array(2)="zorro"
array(3)="tintin"
array(4)=""
array(5)="milou"

la fonction offre les options de prendre les éléments vide (4) et également de supprimer les espaces s'il y a lieu dans l'élément récupéré

Code : Tout sélectionner

Function STRExplode( Byval strValue As String, strDelimiter As String, bBlanks As Variant, bTrim As Variant) As Variant
     '++++++++++++++++++++++++++++++++++++++++++++++++
   '+ Découpe une chaine de caractères via un séparateur
   '+ strValue = chaine à eploiter
   '+ strDelimiter =  séparateur (+sieurs caractères possibles
   '+bBlank = true/false si on doit traiter les éléments vides
   '+bTrim = true/false si réduction des espaces dans l'éléments affecté
   '++++++++++++++++++++++++++++++++++++++++++++++++   
   Dim strTemp As String
   Dim strValues() As String
   Dim iPlace As Integer
   Dim idelimLen As Integer
   Dim iValueCount As Integer   
   On Error Goto Erreur   
   '++++++++++++++++++++++++++++++++++++++++
   '+ Le délimiteur peut être sur plusieurs caractères
   '++++++++++++++++++++++++++++++++++++++++
   idelimLen = Len( strDelimiter)
   iPlace = Instr( strValue, strDelimiter)   
   Do While iPlace <> 0      
      '++++++++++++++++++++++++++++++++++++
      '+ Peut-on rangner l'élément dans le tableau
      '++++++++++++++++++++++++++++++++++++
      If (iPlace <> 1 Or bBlanks) Then         
         Redim Preserve strValues(iValueCount) As String         
         '+++++++++++++++++
         '+ on extrait l'élément
         '+++++++++++++++++
         If bTrim Then
            strValues(iValueCount) = Trim$(Left( strValue, iPlace - 1))
         Else
            strValues(iValueCount) = Left( strValue, iPlace - 1)
         End If   
         '+++++++++++++++++++++++++++++++
         '+ On prévoit une place pour le prochain
         '+++++++++++++++++++++++++++++++
         iValueCount = iValueCount + 1         
      End If      
      '+++++++++++++++++++++++++++++++++++
      '+ Détection de la prochaine valeur à extraire
      '+++++++++++++++++++++++++++++++++++
      strValue = Right( strValue, Len( strValue) - iPlace - idelimLen + 1)      
      '++++++++++++++++++++++++
      '+ place du prochain délimiteur
      '++++++++++++++++++++++++
      iPlace = Instr( strValue, strDelimiter)      
   Loop    
   '++++++++++++++++++++++++++++++++++
   '+ On traite le dernier élément de la chaine
   '++++++++++++++++++++++++++++++++++
   If Len( strValue ) <> 0 Or bBlanks Then      
      Redim Preserve strValues(iValueCount) As String       
      '+++++++++++++++++++++++++++++++++
      '+ et ne pas oublier le dernier élément
      '+++++++++++++++++++++++++++++++++
      strValues(iValueCount) = strValue      
   Elseif iValueCount = 0 Then      
      '+++++++++++++++++++++++++++++++++++
      '+ si la chaine est nulle - 1 seul élément null
      '+++++++++++++++++++++++++++++++++++
      Redim Preserve strValues(iValueCount) As String      
   End If   
   STRExplode = strValues   
   exit function
   
Erreur:
   Print "STRExplode() :  Erreur n° ";Err;" - ";Error$;" (ligne ";Erl;")"
   Resume Fin   
   
Fin:   
   
End Functio