Split sur plusieurs critères


Commenter

Contenu du snippet 

Public Function MultiSuperSplit(ByVal strSource As String, _
                                    bolStockeTroncs As Boolean, _
                                    bolStockeSepars As Boolean, _
                                    varSepars As Variant) As String()
On Error GoTo MultiSuperSplitErr
'   Source de taille quelconque, Séparateurs de tailles quelconques
'   Séparateur unique ou tableau de séparateurs (en nombre quelconque)
'   strSource           -> chaîne à traiter
'   bolStockeTroncs     -> garder ou non les troncs
'   bolStockeSepars     -> garder ou non les séparateurs
'   varSepars           -> séparateur ou tableau de séparateurs
    Dim strLue As String 'la chaine lue
    Dim strRes() As String 'temporaire
    Dim varSep As Variant 'pour l'énumération des séparateurs
    Dim i As Long
    i = 1
    
    'arrêt qd chaine cible est vide
    'ou indice parcours au delà chaine
    While Len(strSource) > 0 And Len(strSource) >= i
        'pour chaque séparateur
        For Each varSep In varSepars
            'lit un tronc de la taille du séparateur
            strLue = Mid$(strSource, i, Len(varSep))
            'si le tronc vaut le séparateur et n'est pas vide
            If (strLue = CStr(varSep)) And (strLue <> vbNullString) Then
                's'il faut stocker le tronc
                If bolStockeTroncs Then
                    'ajoute un élément au tableau
                    ReDim Preserve strRes(UBound(strRes) + 1)
                    'stocke le tronc dans le tableau
                    strRes(UBound(strRes)) = Left$(strSource, i - 1)
                End If
                's'il faut stocker le séparateur
                If bolStockeSepars Then
                    'ajoute un élément au tableau
                    ReDim Preserve strRes(UBound(strRes) + 1)
                    'stocke le séparateur
                    strRes(UBound(strRes)) = strLue
                End If
                'consomme le tronc de la chaine et le séparateur
                strSource = Right$(strSource, Len(strSource) - (i + Len(varSep) - 1))
                'indice parcours au départ
                i = 0
                'quitte l'énumération
                Exit For
            End If
        Next varSep
        'incrémente l'indice de parcours
        i = i + 1
    Wend
    'si la chaine n'est pas consommée entièrement
    If Len(strSource) > 0 Then
        's'il faut stocker le tronc
        If bolStockeTroncs Then
            'ajoute un élément
            ReDim Preserve strRes(UBound(strRes) + 1)
            'stocke le dernier tronc
            strRes(UBound(strRes)) = strSource
        End If
    End If
    'publie le tableau
    MultiSuperSplit = strRes
    
Exit Function
MultiSuperSplitErr:
    'si le tableau n'est pas initialisé
    If Err.Number = 9 Then
        ReDim strRes(0) 'initialise à 1 élément
        Resume Next 'reprend l'exécution à la suite
    'si on reçoit un séparateur au lieu d'un tableau
    ElseIf Err.Number = 13 Then
        varSepars = Array(varSepars) 'transtype en tableau
        Resume 'reprend à l'erreur
    Else
        'c'est mort
        MsgBox Err.Number & _
                vbCrLf & Err.Description & _
                vbCrLf & "MultiSuperSplit()" & _
                vbCrLf & "Prévenez RVBLog, S.V.P.!"
    End If
End Function
'Exemple d'utilisation (pas grand chose n'a changé)
'faites un copier/coller pour tester (parce qu'à lire...)
Private Sub Command1_Click()
    MsgBox Join(MultiSuperSplit("abc%edef%ighi%jjkl", True, True, "%e"), "_")
    MsgBox Join(MultiSuperSplit("abc%edef%ighi%jjkl", True, True, Array("%e", "%i", "%j")), "_")
    MsgBox Join(MultiSuperSplit("abc%edef%ighi%jjkl", True, False, Array("%e", "%i", "%j")), "_")
    MsgBox Join(MultiSuperSplit("abc%edef%ighi%jjkl", False, True, Array("%e", "%i", "%j")), "_")
    
    MsgBox Join(MultiSuperSplit("", True, True, Array("%e", "%i", "%j")), "_")
    MsgBox Join(MultiSuperSplit("abc", True, True, Array("")), "_")
    MsgBox Join(MultiSuperSplit("abc", True, True, vbNullString), "_")
    MsgBox Join(MultiSuperSplit(vbNullString, True, True, "abc"), "_")
    MsgBox Join(MultiSuperSplit(vbNullString, True, True, Null), "_")
    MsgBox Join(MultiSuperSplit("", True, True, Array("")), "_")
    MsgBox Join(MultiSuperSplit("", True, True, ""), "_")
    
    MsgBox Join(MultiSuperSplit("123", True, True, 2), "_")
    MsgBox Join(MultiSuperSplit("123", True, True, "abcdefghijklmnopqrstuvw"), "_")
    MsgBox Join(MultiSuperSplit("abc%edef%ighi%jjkl", True, True, Array("%e", "%i", "%j")), "_")
End Sub

Compatibilité : VB6

Disponible dans d'autres langages :

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (PCPT)