文字操作 指定文字列を最後から検索した文字を２分割する
※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。
※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。
'最後から検索 Function FirstStrSearchLast(str As String, searchStr As String) '********************************************* '指定文字列を最後から検索した文字を２分割する '********************************************* '返値：最初（左）の文字が返ります。 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) '********************************************* '指定文字列を最後から検索した文字を２分割する '********************************************* '返値：最後（右）の文字が返ります。 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) '********************************************* '指定文字列を最初から検索した文字を２分割する '********************************************* '返値：最初（左）の文字が返ります。 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) '********************************************* '指定文字列を最初から検索した文字を２分割する '********************************************* '返値：最後（右）の文字が返ります。 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 |