『Split, Join』 ～ 車輪の再発明シリーズ ～ http://www.moug.net/faq/viewtopic.php?t=65807

Module1.vb

Option Explicit

Sub SplitTest()
    Dim Result() As String
    Dim ErrNum As Long
    
    Result = Split("")
    Debug.Assert LBound(Result) = 0 And UBound(Result) = -1
    
    Result = Split("A,B,C", ",", 0)
    Debug.Assert LBound(Result) = 0 And UBound(Result) = -1
    
    Result = Split("A,B,C", "")
    Debug.Assert Result(0) = "A,B,C"
    
    Result = Split("A,B,C", ",", 1)
    Debug.Assert Result(0) = "A,B,C"
    
    On Error Resume Next
    Result = Split("A,B,C", ",", -2)
    ErrNum = Err.Number
    On Error GoTo 0
    Debug.Assert ErrNum = 5
    
    Result = Split("A,B,C", "x")
    Debug.Assert Result(0) = "A,B,C"
    
    Result = Split("A B C")
    Debug.Assert Result(0) = "A" And Result(1) = "B" And Result(2) = "C"
    
    Result = Split("A,B,C", ",")
    Debug.Assert Result(0) = "A" And Result(1) = "B" And Result(2) = "C"

    Result = Split("A,,B,,C", ",")
    Debug.Assert Result(0) = "A" And Result(1) = "" And Result(2) = "B" _
         And Result(3) = "" And Result(4) = "C"

    Result = Split(",A,B,C,", ",")
    Debug.Assert Result(0) = "" And Result(1) = "A" And Result(2) = "B" _
         And Result(3) = "C" And Result(4) = ""

    Result = Split("AxxxBxxxC", "xxx")
    Debug.Assert Result(0) = "A" And Result(1) = "B" And Result(2) = "C"
    
    Result = Split("ほっともぐひといきもぐ給湯室", "もぐ")
    Debug.Assert Result(0) = "ほっと" And Result(1) = "ひといき" _
        And Result(2) = "給湯室"

    Result = Split("A,B,C", ",", 1)
    Debug.Assert Result(0) = "A,B,C"
    
    Result = Split("A,B,C", ",", 2)
    Debug.Assert Result(0) = "A" And Result(1) = "B,C"

    Result = Split("A,B,C", ",", 3)
    Debug.Assert Result(0) = "A" And Result(1) = "B" And Result(2) = "C"

    Result = Split("A,B,C", ",")
    Debug.Assert Result(0) = "A" And Result(1) = "B" And Result(2) = "C"

    Result = Split("A,B,C", ",", -1)
    Debug.Assert Result(0) = "A" And Result(1) = "B" And Result(2) = "C"
End Sub

Function Split(Expression As String _
    , Optional Delimiter _
    , Optional Limit As Long = -1 _
    , Optional Compare As VbCompareMethod = vbBinaryCompare)
    
    Dim Result() As String
    Dim DelimLen As Long
    Dim ExpLen As Long
    Dim DelimPos As Long
    Dim StartPos As Long
    Dim u As Long
    
    If Limit < -1 Then
        ' プロシージャの呼び出し、または引数が不正です。
        Err.Raise 5
    End If

    If IsMissing(Delimiter) Then
        Delimiter = " "
    End If

    DelimLen = Len(Delimiter)
    ExpLen = Len(Expression)
    
    If DelimLen = 0 Or Limit = 1 Then
        ReDim Result(0) As String
        Result(0) = Expression
    ElseIf ExpLen = 0 Or Limit = 0 Then
        Result = EmptyArray
    Else
        DelimPos = 0
        StartPos = 1
        u = -1
        
        Do
            DelimPos = InStr(DelimPos + 1, Expression, Delimiter, Compare)
            If DelimPos = 0 Then
                Exit Do
            Else
                u = u + 1
                ReDim Preserve Result(u) As String
                Result(u) = Mid$(Expression, StartPos, DelimPos - StartPos)
                StartPos = DelimPos + DelimLen
                
                If u + 2 = Limit Then
                    Exit Do
                End If
            End If
        Loop
        
        u = u + 1
        ReDim Preserve Result(u) As String
        Result(u) = Mid$(Expression, StartPos)
    End If
    
    Split = Result
End Function

Module2.vb

Option Explicit

Sub JoinTest()
    Debug.Assert Join(Split("")) = ""
    Debug.Assert Join(Array("A", "B", "C")) = "A B C"
    Debug.Assert Join(Array("A", "B", "C"), "") = "ABC"
    Debug.Assert Join(Array("A", "B", "C"), "hoge") = "AhogeBhogeC"
    Debug.Assert Join(Array("ほっと", "ひといき", "給湯室"), "もぐ") _
        = "ほっともぐひといきもぐ給湯室"
End Sub

Function Join(SourceArray, Optional Delimiter) As String
    Dim l As Long
    Dim u As Long
    Dim i As Long
    Dim Result As String
    Dim DelimLen As Long
    Dim ResultLen As Long
    Dim PairLen As Long
    Dim NextPos As Long

    l = LBound(SourceArray)
    u = UBound(SourceArray)
    
    If l > u Then
        Result = ""
    ElseIf l = u Then
        Result = SourceArray(l)
    Else
        If IsMissing(Delimiter) Then
            Delimiter = " "
        End If
    
        ' 結合後の文字列の長さ分の半角スペースで埋めた変数を作る
        DelimLen = Len(Delimiter)
        ResultLen = DelimLen * (u - l)
        For i = l To u
            ResultLen = ResultLen + Len(SourceArray(i))
        Next i
        Result = String(ResultLen, " ")
        
        NextPos = 1
        For i = l To u - 1
            PairLen = Len(SourceArray(i)) + DelimLen
            Mid(Result, NextPos, PairLen) = SourceArray(i) & Delimiter
            NextPos = NextPos + PairLen
        Next i
        Mid(Result, NextPos, Len(SourceArray(u))) = SourceArray(u)
    End If
    
    Join = Result
End Function

Module3.vb

Option Explicit

' 「String(0 to -1)」型変数の作り方を教えて下さい
' http://www.moug.net/faq/viewtopic.php?t=65745

Declare Sub RtlMoveMemory Lib "Kernel32" _
    (pDesc As Any, _
     pSrc As Any, _
     Optional ByVal cbLen As Long = 4)
     
Type SAFEARRAY
    cDims As Integer
    fFeatures As Integer
    cbElements As Long
    cLocks As Long
    pvData As Long
    cElements As Long
    lLbound As Long
End Type
    
Const FADF_AUTO_FIXEDSIZE = &H11

Function EmptyArray() As Variant
    Dim sa As SAFEARRAY
    Dim p As Long
    Dim Result() As String
    
    With sa
        .cDims = 1
        .cbElements = 4
        .fFeatures = FADF_AUTO_FIXEDSIZE
    End With
    
    p = VarPtr(p) - 4
    
    RtlMoveMemory ByVal p, VarPtr(sa)
    EmptyArray = Result
    
    ' ↓ 必ずこれを実行し終了。そうじゃないと落ちる。
    RtlMoveMemory ByVal p, 0&
End Function