Option Explicit

'===========================================================
' 文字列分離
'  Ver  1.0
'    [戻り値]:
'      Variant
'      分離した文字は、String()で返却
'      分離する文字がない場合、Empty値
'    [引  数]:
'      isSorceString(String)
'        分離したい文字列
'      isLimitString(String)
'        分離したい文字列内のデリミタ文字
'
'===========================================================
Function SpilitString( _
  isSorceString As String _
  , isLimitString As String _
  ) As Variant

  Dim lsRetArray() As String

  Dim liRetArrayIndex As Integer
  liRetArrayIndex = -1

  Dim lsChkCharCur As String
  Dim lsChkCharBef As String

  Dim liLoopCounter1 As Integer
  For liLoopCounter1 = 1 To Len(isSorceString) Step 1
    'チェックする1文字を抽出
    lsChkCharCur = Mid(isSorceString, liLoopCounter1, 1)

    '区切文字が判定
    If (lsChkCharCur <> isLimitString) Then

      '１文字前が区切文字の場合、設定する返却配列を用意
      lsChkCharBef = ""
      If (liLoopCounter1 <> 1) Then
        lsChkCharBef = _
          Mid(isSorceString, liLoopCounter1 - 1, 1)
      End If
      If (liLoopCounter1 = 1) Or _
          (lsChkCharBef = isLimitString) Then
        liRetArrayIndex = liRetArrayIndex + 1
        ReDim Preserve lsRetArray(liRetArrayIndex)
      End If

      '返却配列に格納
      lsRetArray(liRetArrayIndex) = _
        lsRetArray(liRetArrayIndex) & lsChkCharCur
    End If

  Next liLoopCounter1

  If (liRetArrayIndex > -1) Then
    SpilitString = lsRetArray
  End If

End Function

'===========================================================
' テスト用
'===========================================================
Sub call_SpilitString()

  Dim lvRet As Variant

  lvRet = _
    SpilitString( _
      getSysParaBySheet(ActiveSheet.Name, "D02P1"), _
      getSysParaBySheet(ActiveSheet.Name, "D02P2") _
    )

  Dim lsMsg As String
  lsMsg = lsMsg & "[" & _
    getSysParaBySheet(ActiveSheet.Name, "D02P1") & _
      "]" & Chr(10) & _
      getSysParaBySheet(ActiveSheet.Name, "D02P2") & _
      "]" & Chr(10) & Chr(10)

  If (IsEmpty(lvRet)) Then
    lsMsg = lsMsg & "IsEmpty!" & Chr(10)
  Else
    lsMsg = "UBound=" & UBound(lvRet) & Chr(10)
    Dim liLoopCounter2 As Integer
    For liLoopCounter2 = 0 To UBound(lvRet) Step 1
      lsMsg = _
        lsMsg & _
        "(" & liLoopCounter2 & ")" & _
        "[" & lvRet(liLoopCounter2) & "]" & Chr(10)
    Next liLoopCounter2
  End If

  MsgBox lsMsg

End Sub