(Mini VBA No3)「文字列を分割する」

今のVBAには同様の関数があるはずですが(splitだったかな?) cheeky

Sub testSlice()
    Dim ret     As Variant
    Dim str     As Variant
    Dim dat     As String
    Dim delim   As String

    dat = "sssssnsdnfk"
    delim = "sn"
    ret = slice(dat, delim)
    If (IsNull(ret)) Then
        Debug.Print "null"
    Else
        For Each str In ret
            Debug.Print str
        Next
    End If
End   Sub

Option Explicit

' 文字列strを文字列delimで区切り、配列にして返す
' delimは配列に含まれない
'
' INPUT     : str       分割する文字列
'           : delim     区切り文字列
' OUTPUT    : なし
' RETURN    : 分割されたStringの配列
'           : Null (どちらからの引数がnullの時)

Public Function slice(ByRef str As String, ByVal delim As String) As Variant
    Dim strLen      As Integer
    Dim pos         As Integer
    Dim spos        As Integer
    Dim i           As Integer
    Dim retStrs()   As String
    Dim dataCount   As Integer

    'いずれかがNullの場合はNullを返す
    If (IsNull(str) Or IsNull(delim)) Then
        slice = Null
        Exit Function
    End If

    strLen = Len(str)
    ReDim retStrs(1 To 1)   '必ず1件は返す

    If (strLen = 0) Then        '分割する文字列が""の場合
        retStrs(1) = ""
    ElseIf (delim = "") Then    '区切り文字列が""の場合
        retStrs(1) = str
    Else
        dataCount = 1
        spos = 1    '検索開始位置
        pos = 1     '検索結果(最初は0以外にする)
        Do While (spos <= strLen And pos <> 0)
            If (dataCount > 1) Then
                ReDim Preserve retStrs(1 To dataCount)
            End If

            pos = InStr(spos, str, delim, vbTextCompare)
            If (pos = 0) Then   '最後
                retStrs(dataCount) = Mid$(str, spos)
            Else                '途中
                retStrs(dataCount) = Mid$(str, spos, pos - spos)
                spos = pos + Len(delim)
                dataCount = dataCount + 1
            End If
        Loop
    End If

    slice = retStrs
End Function

 

コメントを残す

メールアドレスが公開されることはありません。 が付いている欄は必須項目です

CAPTCHA


このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください