Option Explicit

'--------------------------------------
' 指定したセパレータ(データの区切り)ごとに
' 文字列を分解する関数です
'
' 戻り値:バリアント型(配列の文字列型)が返ります
'
'--------------------------------------
' New Split Function
'strString      分解の対象になる文字列です
'strSeparator   strStringを分解する区切りとなる文字列です
'lngLimit       分解数の上限です
Function MySplit2(ByVal strString As String, ByVal strSeparator As String, Optional ByVal lngLimit As Long) As Variant
    Dim lngLen      As Long
    Dim lngStart    As Long
    Dim lngEnd      As Long
    Dim varArray()  As String
    Dim lngCount    As Long
    
    
    '変数の値の初期化をします
    lngStart = 1
    'セパレータを検索します
    lngEnd = InStr(lngStart, strString, strSeparator)
    
    '指定のセパレータが見つからないは、
    'この関数から出ます
    If lngEnd = 0 Or strString = "" _
            Or strSeparator = "" Or lngLimit < 0 Then Exit Function
    
    Do
        'この関数をこれ以上改良しない場合は、
        'DoEventsをはずしてください
        DoEvents
        
        'lngLimitが1のときだけ例外処理をします
        If Not (lngLimit = 1) Then
            '分解した文字列を配列に格納します
            lngCount = lngCount + 1
            ReDim Preserve varArray(1 To lngCount)
            varArray(lngCount) = Mid(strString, lngStart, lngEnd - lngStart)
            
            '再度、指定のセパレータを検索します
            lngStart = lngEnd + 1
            lngEnd = InStr(lngStart, strString, strSeparator)
        End If
        
        'セパレータが見つからなかった場合は、
        '前回セパレータが見つかった位置(lngStart)から
        '文字列の最後までを配列に格納してループから脱出します
        'lngLimitが0のときは区切りとなる文字列が検索し終えるまで探します
        'lngLimitが0以上のときは探し出した数と一致するように配列の数を合わせます
        If IIf(lngLimit = 0, lngEnd = 0, lngEnd = 0 Or lngCount >= lngLimit - 1) Then
            lngCount = lngCount + 1
            ReDim Preserve varArray(1 To lngCount)
            varArray(lngCount) = Mid(strString, lngStart)
            Exit Do
        End If
        
    Loop
    
    '関数へ配列を返します
    MySplit2 = varArray
End Function

'実行ボタンをクリックしました
Private Sub Command1_Click()
    Dim var     As Variant
    Dim x       As Variant
    
    'List1の内容をクリアにします
    List1.Clear
    
    '指定した文字列を分解します
    var = MySplit2(Text1.Text, Text2.Text, CLng(Text3.Text))
    
    '文字列をしてしないとvarの中身がEmptyになります
    If IsEmpty(var) = True Then Exit Sub
    
    'バリアント変数の中身をすべて展開します
    For Each x In var
        List1.AddItem x
    Next
End Sub