今のVBAには同様の関数があるはずですが(splitだったかな?)
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