VBA 特定文字以降削除

Question

下のコードの様に特定文字以下を取得できたのですが、削除の仕方がわからないので教えてください。
よろしくお願いします。

Sub check()
Dim s As String
s = Cells(1, 2).Value
s = Mid(s, InStr(s, "\") + 1)
Cells(1, 10).Value = s
End Sub

この画像の様にa.xslmfolder\yamadaの￥yamadaを削除したいです。
また　逆に￥より左を削除する方法もわかりません。教えてください。お願いします。

Comments

[m.ts10806]

>特定文字以下を取得できた
それなら「できた」と言えませんか？
あくまで「1文字目から特定文字列目を取得」で目的達せられそうに思います。

[akakatsu]

取得はできるのですが、削除の方法がわかりません

[Usirow]

まずはこの質問のタイトルをそのままグーグルで検索してみてください。解説しているサイトがいっぱい出てきます。

[m.ts10806]

いやですから、取得した文字列でそのまま上書きすれば「削除した」ことになりませんか？と言う話をしています。

[m.ts10806]

abと言う文字列をもった領域に対してaという文字列を入れればbはなくなりますよね。

[akakatsu]

ｂは取得できたのですが、\マーク以前のaは取得できていません。
aを取得する方法を聞いているのです。

[m.ts10806]

「1文字目から特定文字列目を取得」に対して「取得はできるのですが」と書いているのでできてるものと思ったのですが。

Answer 1

そこまでできてるなら出来そうなもんだけど。
文字列加工はLeftかRightかMidがあればなんとかなるので、質問する前に色々試してみましょう。

Sub check()
    Dim s As String
    Dim p As Long
    s = Cells(1, 2).Value
    p = InStr(s, "\")
    Cells(1, 10).Value = left(s, p - 1)
    Cells(2, 10).Value = Mid(s, p)
End Sub

Answer 2

正規表現を使うと色々出来て面白いです。(参考まで)
(参照設定必要:Microsoft VBScript Regular Expression .)

Option Explicit
Sub Test_Sample_Miniature()
    Dim MyRange As Range
    Dim s As String
    Dim re As RegExp
    Dim mc As MatchCollection
    Set re = CreateObject("VBScript.RegExp")
    re.IgnoreCase = False
    re.Global = True
    For Each MyRange In Range("A1:A6")
        '
        re.Pattern = "^.*(?=\)"
        s = MyRange.Value
        Set mc = re.Execute(s)
        Cells(MyRange.Row, 10) = mc(0).Value
        '
        re.Pattern = "^.*\"
        Cells(MyRange.Row, 11) = re.Replace(s, "")
        '
    Next
    Set re = Nothing
    Set mc = Nothing
End Sub

Answer 3

いろいろな方法を覚えておくと、場面に応じて追加分けできると思いますので、ご参考までに。

Sub sample()
    Dim s As String
    Dim a
    s = Cells(1, 1).Value
    a = Split(s, "\")
    Cells(1, 10).Value = a(0)
    Cells(1, 11).Value = a(1)
End Sub

VBA Split 関数

Sub sample()
    Range("A1:A10").TextToColumns _
        Destination:=Range("J1"), _
        OtherChar:="\"
End Sub

範囲の TextToColumns メソッド (Excel) | Microsoft Docs