文字操作 指定文字列を最後から検索した文字を2分割する

VB&VBA
FROG ふろっぐ
 
  • オプション

    本文印刷

    お気に入りに追加

  • 検索

    Googlewwwjp-ia
     

    Googlewwwjp-ia
     
  • 情報

  • 関連

[VB&VBA][文字操作 指定文字列を最後から検索した文字を2分割する]
Option Explicit


'最後から検索

Function FirstStrSearchLast(str As String, searchStr As String)
'*********************************************
'指定文字列を最後から検索した文字を2分割する
'*********************************************
'返値:最初(左)の文字が返ります。
Dim FirstStr As String, LastStr As String, i As Long
If InStr(1, str, searchStr) = 0 Then GoTo ErrEnd:
i = InStrRev(str, searchStr)
FirstStr = Left(str, i - 1)
LastStr = Mid(str, i + 1)
FirstStrSearchLast = FirstStr
Exit Function
ErrEnd:
FirstStrSearchLast = ""
End Function


Function LastStrSearchLast(str As String, searchStr As String)
'*********************************************
'指定文字列を最後から検索した文字を2分割する
'*********************************************
'返値:最後(右)の文字が返ります。
Dim FirstStr As String, LastStr As String, i As Long
If InStr(1, str, searchStr) = 0 Then GoTo ErrEnd:
i = InStrRev(str, searchStr)
FirstStr = Left(str, i)
LastStr = Mid(str, i + 1)
LastStrSearchLast = LastStr
Exit Function
ErrEnd:
LastStrSearchLast = ""
End Function


'最初から検索

Function FirstStrSearchFirst(str As String, searchStr As String)
'*********************************************
'指定文字列を最初から検索した文字を2分割する
'*********************************************
'返値:最初(左)の文字が返ります。
Dim FirstStr As String, LastStr As String, i As Long
If InStr(1, str, searchStr) = 0 Then GoTo ErrEnd:
i = InStr(str, searchStr)
FirstStr = Left(str, i - 1)
LastStr = Mid(str, i + 1)
FirstStrSearchFirst = FirstStr
Exit Function
ErrEnd:
FirstStrSearchFirst = ""
End Function


Function LastStrSearchFirst(str As String, searchStr As String)
'*********************************************
'指定文字列を最初から検索した文字を2分割する
'*********************************************
'返値:最後(右)の文字が返ります。
Dim FirstStr As String, LastStr As String, i As Long
If InStr(1, str, searchStr) = 0 Then GoTo ErrEnd:
i = InStr(str, searchStr)
FirstStr = Left(str, i)
LastStr = Mid(str, i + 1)
LastStrSearchFirst = LastStr
Exit Function
ErrEnd:
LastStrSearchFirst = ""
End Function


Private Sub test()
Dim strTest As String, SearChTest As String
    strTest = "本日 は 晴天 なり"
    SearChTest = " "
    Debug.Print FirstStrSearchLast(strTest, SearChTest)     '本日 は 晴天
    Debug.Print LastStrSearchLast(strTest, SearChTest)      'なり
    Debug.Print FirstStrSearchFirst(strTest, SearChTest)    '本日
    Debug.Print LastStrSearchFirst(strTest, SearChTest)     'は 晴天 なり
    strTest = "本日-は-晴天-なり"
    SearChTest = "-"
    Debug.Print FirstStrSearchLast(strTest, SearChTest)     '本日 は 晴天
    Debug.Print LastStrSearchLast(strTest, SearChTest)      'なり
    Debug.Print FirstStrSearchFirst(strTest, SearChTest)    '本日
    Debug.Print LastStrSearchFirst(strTest, SearChTest)     'は 晴天 なり
End Sub


'参考

Function GetFileName(strPath As String)
'*********************************
'パス文字列からファイル名だけ検出
'*********************************
'パスらしくない場合は空白を返す
'パスは最後の\を除く
Dim Pth As String, Fl As String
If InStr(1, strPath, ".") = 0 Then GoTo ErrEnd:
If InStr(1, strPath, "\") = 0 Then GoTo ErrEnd:
Fl = Dir(strPath)
Pth = Replace(strPath, Fl, "")
Pth = Mid(Pth, 1, Len(Pth) - 1)
GetFileName = Fl
Exit Function
ErrEnd:
GetFileName = ""
End Function


Function GetPathName(strPath As String)
'*********************************
'パス文字列からパスだけ検出
'*********************************
'パスらしくない場合は空白を返す
'パスは最後の\を除く
Dim Pth As String, Fl As String
If InStr(1, strPath, ".") = 0 Then GoTo ErrEnd:
If InStr(1, strPath, "\") = 0 Then GoTo ErrEnd:
Fl = Dir(strPath)
Pth = Replace(strPath, Fl, "")
Pth = Mid(Pth, 1, Len(Pth) - 1)
GetPathName = Pth
Exit Function
ErrEnd:
GetPathName = ""
End Function


Private Sub testg()
Dim strTest As String
strTest = ThisWorkbook.Path & "\" & ThisWorkbook.Name
    Debug.Print GetFileName(strTest)
    Debug.Print GetPathName(strTest)
End Sub







Production Japan Import Application. Since 1998