指定文字列の左側または右側を切り出す

今回は指定文字列の左側または右側を切り出すコードを考えてみたいと思います。例えば、氏名から、スペースを境にして姓と名を切り出したい･･････。とか。
ただ、そんなのは既に世の中にある気がするので、そこから半歩進んだ処理も考えてみたいと思います。

境にしたい指定文字列がセル内に複数ある場合、左から何個目かを指定できるようにする。

こんな感じ。

左から２個目の全角スラッシュを境にして、左側または右側を切り出したい。

左側を切り出した結果

右側を切り出した結果

ということで、コードを作ってみました。（ついでに、指定文字列を含んで切り出すかどうかも選択できるようにした）

左側を切り出すコード

Sub 指定文字の左側を切り出す()
    '選択範囲に対して処理を行います
    Dim 指定文字 As String
    Dim 境 As Integer
    Dim tmp As Integer
    Dim 含 As Integer
    Dim myRange As Range
    Dim 始 As Integer
    Dim i As Integer
    Dim 位置 As Integer
    
    指定文字 = InputBox("指定文字を入力して下さい。")
        If 指定文字 = "" Then Exit Sub
        
    境 = InputBox("左から何個目の指定文字を境にしますか？")

    tmp = MsgBox("指定文字を含んで切り出しますか？", vbYesNoCancel)
        If tmp = vbYes Then
            含 = Len(指定文字)
        ElseIf tmp = vbNo Then
            含 = 0
        Else
            Exit Sub
        End If

    For Each myRange In Selection
        始 = 1  '検索開始位置

        For i = 2 To 境 '左から2個目以降の指定文字を境にした場合の検索開始位置を求める
            If InStr(始, myRange.Value, 指定文字) > 0 Then
                始 = InStr(始, myRange.Value, 指定文字) + Len(指定文字)
            Else
                Exit For
            End If
        Next i
    
        位置 = InStr(始, myRange.Value, 指定文字)
        
        If 位置 > 0 Then
            myRange.Value = Left(myRange.Value, 位置 + 含 - 1)
        End If
        
    Next myRange
    
End Sub

右側を切り出すコード

Sub 指定文字の右側を切り出す()
    '選択範囲に対して処理を行います
    Dim 指定文字 As String
    Dim 境 As Integer
    Dim tmp As Integer
    Dim 含 As Integer
    Dim myRange As Range
    Dim 始 As Integer
    Dim i As Integer
    Dim 位置 As Integer
    
    指定文字 = InputBox("指定文字を入力して下さい。")
        If 指定文字 = "" Then Exit Sub
        
    境 = InputBox("左から何個目の指定文字を境にしますか？")

    tmp = MsgBox("指定文字を含んで切り出しますか？", vbYesNoCancel)
        If tmp = vbYes Then
            含 = 0
        ElseIf tmp = vbNo Then
            含 = Len(指定文字)
        Else
            Exit Sub
        End If

    For Each myRange In Selection
        始 = 1  '検索開始位置

        For i = 2 To 境 '左から2個目以降の指定文字を境にした場合の検索開始位置を求める
            If InStr(始, myRange.Value, 指定文字) > 0 Then
                始 = InStr(始, myRange.Value, 指定文字) + Len(指定文字)
            Else
                Exit For
            End If
        Next i
    
        位置 = InStr(始, myRange.Value, 指定文字)
        
        If 位置 > 0 Then
            myRange.Value = Right(myRange.Value, Len(myRange.Value) - 位置 - 含 + 1)
        End If
        
    Next myRange
    
End Sub

※コードの使用方法

SubからEnd Subまでをコピーし、標準モジュール等に貼り付けて使用して下さい。なお、マクロで実行した処理は「元に戻す」ことができません。実行前に一旦保存しやり直しのできる状態にしておいて下さい。標準モジュールにコードを貼り付けてマクロを使用する方法はこちら。

実行手順

1. 処理したい範囲を選択してマクロを実行する。
2. InputBoxが表示されるので、指定文字列を入力する。（必ずしも、1文字である必要は無い）
3. 引き続きInputBoxが表示されるので、左から何個目の指定文字列を境にするかを入力する。
4. 指定文字列を含んで切り出すかどうかを、「はい」「いいえ」で選択する。

プログラムの説明

• InputBoxおよびMsgBoxで処理に必要な情報の入力を促す。
• For Each ～Nextで選択範囲に対して順番に処理を行う。
• 文字列検索開始位置の初期値を1文字目とする。
• For ～Nextの処理。境とする文字列を左から2個目以降とした場合の、文字列検索開始位置を求める。（左から1文字目とした場合、このループには入らない）
• InStr関数で、指定文字列（n個目）の位置を求める。
• 左側から（または右側から）指定文字列の手前までを切り出す。※指定文字列を含むを「はい」にした場合は、含んで切り出す。

余談ですが、Excel 2013以降であればフラッシュフィルで似たようなこともできます。（ただ、フラッシュフィルでは思った通りの結果にならないこともあったりする）

追記

ことりちゅんさんのコメントにあるように、Split関数の第三引数 Limitを活用したコードを作ってみました。元のコードは極力そのままでSplit関数に置き換えています。右側を切り出すコードに関してはかなりスッキリしました。

右側を切り出すコード（元コードとの違いを赤にしています）

Sub 指定文字の右側を切り出すlimit版()
    '選択範囲に対して処理を行います
    Dim 指定文字 As String
    Dim 境 As Integer
    Dim tmp As Integer
    Dim 含 As String
    Dim myRange As Range
    Dim 配列 As Variant
    
    指定文字 = InputBox("指定文字を入力して下さい。")
        If 指定文字 = "" Then Exit Sub
        
    境 = InputBox("左から何個目の指定文字を境にしますか？")

    tmp = MsgBox("指定文字を含んで切り出しますか？", vbYesNoCancel)
        If tmp = vbYes Then
            含 = 指定文字
        ElseIf tmp = vbNo Then
            含 = ""
        Else
            Exit Sub
        End If

    For Each myRange In Selection
        配列 = Split(myRange.Value, 指定文字, 境 + 1)
        myRange.Value = 含 & 配列(UBound(配列))
        
    Next myRange
    
End Sub

左側を切り出すコード（上記、右側を切り出すコードとの違いを紫にしています） 

Sub 指定文字の左側を切り出すlimit版()
    '選択範囲に対して処理を行います
    Dim 指定文字 As String
    Dim 境 As Integer
    Dim tmp As Integer
    Dim 含 As String
    Dim myRange As Range
    Dim 総数 As Integer
    Dim 配列 As Variant
    
    指定文字 = InputBox("指定文字を入力して下さい。")
        If 指定文字 = "" Then Exit Sub
        
    境 = InputBox("左から何個目の指定文字を境にしますか？")

    tmp = MsgBox("指定文字を含んで切り出しますか？", vbYesNoCancel)
        If tmp = vbYes Then
            含 = 指定文字
        ElseIf tmp = vbNo Then
            含 = ""
        Else
            Exit Sub
        End If

    For Each myRange In Selection
        総数 = (Len(myRange.Value) - Len(Replace(myRange.Value, 指定文字, ""))) / Len(指定文字)   'セル内の指定文字の総数を求める
        配列 = Split(StrReverse(myRange.Value), StrReverse(指定文字), 総数 - 境 + 2)
        myRange.Value = StrReverse(配列(UBound(配列))) & 含
        
    Next myRange
    
End Sub