Function MultiSplit(ByVal sStr As String, bKeepSepar As Boolean, ParamArray aArray()) As String()
'    sStr        -> chaîne à  parser
'    bKeepSepar  -> garder ou non les  caractères de référence
'    aArray      ->  tableau des références de taille variables
    Dim sCol As New Collection
    Dim sChar          As String, sLeft As String
    Dim bFound         As Boolean
    Dim aRes()         As String
    Dim i              As Integer, j As Integer, NbCarac As  Integer
    i = 0
    
    While LenB(sStr) > 0
        i = i + 1
        bFound = False
        For j = LBound(aArray) To UBound(aArray)
            NbCarac = Len(aArray(j))
            sChar = Mid$(sStr, i, NbCarac)
            If sChar = CStr(aArray(j)) Then bFound = True: Exit  For
        Next j
        If bFound Then
            sLeft = Left$(sStr, i - 1)
            If LenB(sLeft) > 0 Then sCol.Add sLeft
            If bKeepSepar Then sCol.Add sChar
            sStr = Right$(sStr, Len(sStr) - (NbCarac + (i - 1)))
            i = 0
        ElseIf sChar = vbNullString Then
            sCol.Add sStr
            sStr = vbNullString
        End If
    Wend
    ReDim aRes(sCol.Count - 1)
    For i = 1 To sCol.Count
        aRes(i - 1) = sCol.Item(i)
    Next i
    MultiSplit = aRes
    
    Set sCol = Nothing
    Erase aRes
End Function
'  EXEMPLE  D'UTILISATION
Private Sub Form_Load()
    Dim a$(), i%
    a = MultiSplit( _
          "Function MultiSplit(ByVal sStr As String, bKeepSepar As Boolean,  ParamArray aArray()) As  String()", _
          False, "(", ")", ",", "String", " ")
    For i = 0 To UBound(a)
        Debug.Print "_" & a(i) & "_"
    Next i
End Sub

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