VBA 指定文字列が出てきたら、左の文字は削除する

質問

お世話になっております。
Excel2003を使用しております。

指定文字列が出てきたら、左にある文字は全て削除したいと思っております。

例）

番号：0001　　名前：　佐藤　太郎 　　趣味：散歩

↓「名前：より左は削除」

名前：　佐藤　太郎 　　趣味：散歩

また、出来たら指定文字列より右にあるものも削除できたら良いなと思っております。

例）
番号：0001　　名前：　佐藤　太郎 　　趣味：散歩

↓「趣味：より右は削除」

番号：0001　　名前：　佐藤　太郎

色々試してみています。
今後もたくさんのプログラムに使っていくことも考え、配列に入れることも考えています。
LeftDeleteMoji=Array("名前：")
RightDeleteMoji=Array("趣味：")

やりたいこととしては、　　　　　　　　　　　　　　　　 （例）番号：0001　　名前：　佐藤　太郎 　　趣味：散歩
左から指定文字列手前まで抜き出す　とか　　　　（例）「名前：」　名前：　佐藤　太郎 　　趣味：散歩
右から指定文字列まで抜き出す　とか　　　　　　　（例）「趣味：」　番号：0001　　名前：　佐藤　太郎
指定文字列と指定文字列の間を抜き出す　とか　（例）「名前：,趣味：」名前：　佐藤　太郎
があります。

A列を上から順番に行っていき、
必要ない部分はスルーして、必要な部分のみ抜き出し、
別シートに書き込む。　これを行おうと思っています。

If InStr(.Range("A" & i).Value, NeedData(Num)) > 0 And Len(.Range("A" & i).Value) > 0　then
で文字列が含まれているか確認していたのですが、
配列の設定方法なのか、色々良く分からなくなってしまいまいました。

-------------------------------現在のプログラム
NeedData = Array("", "名前：", "名前：", "趣味：")

For i = 1 To MaxRow '重要データ保存
If Num > UBound(NeedData) Then
Num = 0
End If

If InStr(.Range("A" & i).Value, NeedData(Num)) > 0 And Len(.Range("A" & i).Value) > 0 Then '含む場合の動作
If NeedData(Num) = "" Then
If InStr(.Range("A" & i).Value, NeedData(Num + 1)) > 0 Then
EndData = InStr(.Range("A" & i).Value, NeedData(Num + 1))
ThisWorkbook.Worksheets("回答連絡メール内容").Range("A" & TESTRow) = Left(.Range("A" & i).Value, EndData - 1) '左から指定文字が出てくるまで！
Num = Num + 2
TESTRow = TESTRow + 1
End If
Else
StartData = InStr(.Range("A" & i).Value, NeedData(Num)) + Len(NeedData(Num))
EndData = InStr(.Range("A" & i).Value, NeedData(Num + 1))

ThisWorkbook.Worksheets("回答連絡メール内容").Range("A" & TESTRow) = Mid(.Range("A" & i).Value, StartData, EndData) '左から指定文字が出てくるまで！
Num = Num + 2
TESTRow = TESTRow + 1
End If
End If
Next
ーーーーーーーーーーー-------------------

入力されているデータ（元のデータ）は決まりごとがあり、
必ずその文字データはあります。（順番も合っています）
上記プログラムは、配列が空白だったら、配列の2個目を検索して
右にある必要の無いデータは削除する。　そのような流れにしようと思っていました。

話がそれましたが、もっと良い（分かりやすい）プログラム方法がある気がします。
現状、一応完成？というところまできては居ますが、
もし、失敗した場合、どこが原因がハッキリしない感じになってしまっています。

左から指定文字列手前まで抜き出す　　　　（例）「名前：」　名前：　佐藤　太郎 　　趣味：散歩
右から指定文字列まで抜き出す　　　　　　　（例）「趣味：」　番号：0001　　名前：　佐藤　太郎
指定文字列と指定文字列の間を抜き出す　（例）「名前：,趣味：」名前：　佐藤　太郎

良い方法があれば教えて下さい！
よろしくお願い致します！

回答No.1

eden3616 · ベストアンサー

いまいち様式がはっきりしません。
この手の質問ではデータの入力様式が明確にわかるように参照画像があればよいのですが。
行いたいことと異なっていればすいません。

ご提示のコードを一部読んで（全部読んでません）適当に解釈しました。
結果をどうするのかわからなかったのでとりあえず別セルに書き出しています。
（画像でいうところのC列となります）

A列に複数行「番号：○○名前：○○趣味：○○」という様式で入っているデータがあり
指定した箇所を削除したいと解釈しています。

削除する方法ではなく、指定した部分を取り出す方法に勝手に変えてますが。

「action」マクロ実行後、入力ボックスが表示され範囲指定を促されます。
取り出したい範囲を「1～3」の数値で指定してください。
「1-2」、「1-3」や「-3」、「1-」のような範囲指定も可能です。

注）
エラー処理は入れていません。
対象シートは現在アクティブになっているシートを対象にしています。

■VBAコード

Sub action()
Dim word As String
Dim inp As String
Dim chk_inp As Variant
Dim i As Long, j As Integer
Dim key As Variant
Dim ans(2) As String
Dim a As Integer, b As Integer
Dim ans_word(2) As Variant

'分割キーの設定
key = Array("番号", "名前", "趣味")

'範囲入力
inp = InputBox( _
　　prompt:=key(0) & "=1 / " & key(1) & "=2 / " & key(2) & "=3" & vbCrLf & _
　　"として範囲を以下の様式で指定してください。" & vbCrLf & vbCrLf & _
　　" 　n：n番の項目のみ取り出す場合" & vbCrLf & _
　　"n-m：nからm番の項目を取り出す場合" & vbCrLf & _
　　"　-n：n番までの項目を取り出す場合" & vbCrLf & _
　　"　n-：n番からの項目を取り出す場合" & vbCrLf _
　　, Title:="範囲指定")
If inp = "" Then Exit Sub
chk_inp = Split(inp, "-")

'行数繰り返し処理
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
　　'値を格納
　　word = Range("A" & i).Value
　　'値を配列に分割
　　　　'キーで検索
　　　　a = InStr(1, word, key(1))
　　　　b = InStr(1, word, key(2))
　　　　'分割値を格納
　　　　ans_word(0) = Left(word, a - 1) '番号を格納
　　　　ans_word(1) = Mid(word, a, b - a) '名前を格納
　　　　ans_word(2) = Right(word, Len(word) - b + 1) '趣味を格納
　　word = ""
　　'単発かどうかの判定
　　If UBound(chk_inp) = 0 Then
　　　　'単発抜出の場合
　　　　word = ans_word(Int(chk_inp(0)) - 1)
　　Else
　　　　'範囲抜出の場合
　　　　If chk_inp(0) <> "" And chk_inp(1) <> "" Then
　　　　　　'「n-m」を指定した場合
　　　　　　For j = Int(chk_inp(0)) To Int(chk_inp(1))
　　　　　　　　word = word & ans_word(j - 1)
　　　　　　Next j
　　　　Else
　　　　　　'「-n」を指定した場合
　　　　　　If chk_inp(0) = "" Then
　　　　　　　　For j = 1 To Int(chk_inp(1))
　　　　　　　　　　word = word & ans_word(j - 1)
　　　　　　　　Next j
　　　　　　End If
　　　　　　'「n-」を指定した場合
　　　　　　If chk_inp(1) = "" Then
　　　　　　　　For j = Int(chk_inp(0)) To 3
　　　　　　　　　　word = word & ans_word(j - 1)
　　　　　　　　Next j
　　　　　　End If
　　　　End If
　　End If
　　'結果出力
　　Range("C" & i).Value = word
Next i
End Sub

お礼

回答頂きありがとうございます。
>この手の質問ではデータの入力様式が明確にわかるように参照画像があればよいのですが。
以後、気をつけていきます！ご指摘ありがとうございます！

また、教えて頂いたプログラム、
やりたいことが思ったとおりに出来ました！
ありがとうございます＾＾