指定した文字から指定した文字のスペースまでを削除するVBAの構文について

いつもお世話になっております。
この度、タイトルにございます処理についてご教示いただきたく質問させていただきました。
Excelは2019を使用しております。

処理内容を下記にご説明いたします。
B3セルから末尾までの列セルに対し初めの指定文字が【※対応除外】を始点に
終点を【管理番号】：ABC1234 の半角また全角スペースまでの文字列を削除したい処理内容となります。
(※ABC1234の内容はセル事に異なり文字列の長さも変動します)

どうぞよろしくお願いいたします。

質問者からの補足コメント

• 補足させていただきます。
  
  理想の処理といたしまして添付させていただきました画像の様な形を理想としております。
  よろしくお願いいたします。

  
    補足日時：2022/07/25 07:24

No.6 ベストアンサー 回答者： めぐみん_ 回答日時： 2022/07/26 01:40

こうかな？

Sub try_2()
Dim i As Long
Dim v, v1, v2

For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row

If Range("B" & i).Value <> "" Then

v = Split(Range("B" & i).Value, vbLf)

If v(UBound(v)) = "" Then ReDim Preserve v(LBound(v) To UBound(v) - 1)

v1 = Split(v(UBound(v)), "【管理番号】")

If InStr(v1(UBound(v1)), " ") > 0 Then
v2 = Split(v1(UBound(v1)), " ")
ElseIf InStr(v1(UBound(v1)), "　") > 0 Then
v2 = Split(v1(UBound(v1)), "　")
End If

If UBound(v2) > 0 Then v(UBound(v)) = v2(UBound(v2))

Range("B" & i).Value = Join(v, vbLf)
Erase v, v1, v2

End If

Next

End Sub

この回答へのお礼

めぐみん様、回答ありがとうございます！
こちらで理想の処理が実現できました。
大事に活用させていただきます。

御体調優れない中、ありがとうございました。
お大事になさってください。

お礼日時：2022/07/26 14:49

No.5 回答者： めぐみん_ 回答日時： 2022/07/25 10:25

No.2です。

３回目のワクチンを先週末打って翌日から３９℃のホットな時間を過ごしているので、おかしかったとしたらごめんなさい。

Sub try()
Dim v, v1, v2

v = Split(Range("B2").Value, vbLf)

If v(UBound(v)) = "" Then ReDim Preserve v(LBound(v) To UBound(v) - 1)

v1 = Split(v(UBound(v)), "【管理番号】")

If InStr(v1(UBound(v1)), " ") > 0 Then
v2 = Split(v1(UBound(v1)), " ")
ElseIf InStr(v1(UBound(v1)), "　") > 0 Then
v2 = Split(v1(UBound(v1)), "　")
End If

If UBound(v2) > 0 Then v(UBound(v)) = v2(UBound(v2))

Range("B3").Value = Join(v, vbLf)

End Sub

この回答へのお礼

めぐみん様、体調優れない中、回答に重ねVBAの構築ありがとうございます。
こちらの構文で理想の処理が叶いました。
ありがとうございます。

最後に1点ご質問なのですが、初心者知識で色々と調べ
For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row
'B列2行目から最終行まで繰り返し
1セル処理時のエラー対策として
If .Range("B2") <> "" Then
こちらの構文をめぐみん様のVBAに組み込みたいと考えておりまして、どの様な形になりますでしょうか？

重ね重ねで恐縮ではございますが、よろしくお願いいたします。

お礼日時：2022/07/25 21:10

No.4 回答者： ひでオンジ 回答日時： 2022/07/25 08:55

お疲れ様です

この処理は【※対応除外】～全角スペースまでを""に変換しています
こちらを参考にしてみてください
初めての方には正規表現は難しいかもしれませんが、コツを覚えると面白いです。Unoっていうゲームのワイルドカードに似ています
何か分からない事がありましたらまたお願いします
対応出来なかったらNo2さんお願いします

Sub test()
Dim RE As Object
Dim Result As String
Dim Subject As String
Subject = ""
Subject = Subject & "問合せ" & vbLf
Subject = Subject & "OSのバージョンアップが必要。" & vbLf
Subject = Subject & "Windows11への交換をお願いいたします。" & vbLf
Subject = Subject & "【※対応除外】Windows7 → Windows10【管理番号】：VAIO1234　※リカバリディスクの同機もお願いいたします。" & vbLf
Set RE = CreateObject("VBScript.RegExp")
With RE
.Pattern = "【※対応除外】.+　" '←【※対応除外】～全角スペースまで
.IgnoreCase = False
.Global = False
Result = .Replace(Subject, "")
End With
Debug.Print (Result)
End Sub

https://murashun.jp/article/programming/regular- …

No.3 回答者： ひでオンジ 回答日時： 2022/07/25 05:49

No2さん

流石です
そんな簡単な方法があったとは…
私も今後使わせて頂きます

No.2 回答者： めぐみん_ 回答日時： 2022/07/25 03:23

＞初めの指定文字が【※対応除外】を始点に終点を【管理番号】：ABC1234 の半角また全角スペースまでの文字列

初めの指定文字以前に半・全角のスペースが存在するか否かですかね。
『【管理番号】が確実に存在する物』でその後ろのスペース以降が欲しい物なら、『【管理番号】 や【管理番号】　で区切った後半を使用するとかでしょうか。
Split 関数
http://officetanaka.net/excel/vba/tips/tips62.htm

No.1 回答者： ひでオンジ 回答日時： 2022/07/24 23:01

全角スペースまでの文字を削除したいなら正規表現の置換をすれば良いと思います

サンプルを書いておきますので、これをどう実現できるかお考え下さい

Dim RE As Object
Dim Result As String
Const SUBJDCT As String = "ABC1234　ABC"
Set RE = CreateObject("VBScript.RegExp")
With RE
.Pattern = "^\w+　"
.IgnoreCase = False
.Global = False
Result = .Replace(SUBJDCT, "")
End With
Debug.Print (Result)

この回答へのお礼

ひでオンジ様、回答に重ねサンプルの構築ありがとうございます。

お恥ずかしながらVBA初心者なもので始点キーワードの【※対応除外】の構文の組み込みを含め、No.2様がご指摘していただきました始点以前にも文字が入力されており、どの様な構築にすればよろしいのか他の方からの回答をお待ちしてみたいと思います。

お礼日時：2022/07/25 07:15