Function SplitToCollection(ByVal sExpression As String, ByVal sSepar As String) As Collection
'sExpression chaîne à spliter
'sSepar caractère(s) de séparation
'Retour retourne un collection
If (VBA.Strings.LenB(sExpression) = 0) Or (VBA.Strings.LenB(sSepar) = 0) Then Exit Function
Dim oColl As New Collection
Dim i As Long, lPos As Long, sLine As String
Do
lPos = VBA.Strings.InStr(1, sExpression, sSepar)
If lPos Then
oColl.Add VBA.Strings.Left$(sExpression, lPos - 1)
sExpression = VBA.Strings.Mid$(sExpression, lPos + VBA.Strings.Len(sSepar))
End If
Loop Until lPos = 0
If VBA.Strings.LenB(sExpression) Then oColl.Add sExpression
Set SplitToCollection = oColl
Set oColl = Nothing
End Function
' NB : les préfixes "VBA.Strings." sont facultatifs
' ---------------------
' EXEMPLE D'UTILISATION
' ---------------------
Private Sub Form_Load()
Dim s1 As Variant, s2 As Variant
' -----------
' EXEMPLE n°1
' -----------
Const EXEMPLE1 = "je suis une chaîne entrecoupée d'espaces"
Dim oRes1 As Collection
Set oRes1 = SplitToCollection(EXEMPLE1, " ")
Debug.Print EXEMPLE1
Debug.Print "===================================="
For Each s1 In oRes1
Debug.Print s1
Next s1
' ----------------------
Debug.Print vbCrLf & "************************************" & vbCrLf
' -----------
' EXEMPLE n°2
' -----------
Const EXEMPLE2 = _
"Entet1" & vbTab & "Entet2" & vbTab & "Entet3" & vbTab & "Entet4" & vbTab & "Entet5" & vbCrLf & _
"a" & vbTab & "b" & vbTab & "c" & vbTab & "d" & vbTab & "e" & vbCrLf & _
"1" & vbTab & "2" & vbTab & "3" & vbTab & "4" & vbTab & "5" & vbCrLf & _
"6" & vbTab & "7" & vbTab & "8" & vbTab & "9" & vbTab & "10"
Dim oRes2 As Collection, oRes3 As Collection
Set oRes2 = SplitToCollection(EXEMPLE2, vbCrLf)
Debug.Print EXEMPLE2
Debug.Print "===================================="
For Each s1 In oRes2
Debug.Print s1
Debug.Print " --------------------------------"
Set oRes3 = SplitToCollection(s1, vbTab)
For Each s2 In oRes3
Debug.Print " " & s2
Next s2
Debug.Print "----"
Next s1
End Sub