Sub 一種類の特定文字以降を削除する()
Dim strTemp As Variant
Dim i As Integer
Dim j As Integer
Dim strKeyword As String
'検索キーを指定します。
strKeyword = "県"
'処理対象のセルをレンジ指定します。
strTemp = Range("B2:B8")
'配列に格納された値すべてを対象に処理します。
For i = LBound(strTemp, 1) To UBound(strTemp, 1)
For j = LBound(strTemp, 2) To UBound(strTemp, 2)
'末尾が指定文字であるか判定します
If InStr(strTemp(i, j), strKeyword) Then
Cells(i + 1, j + 3) = Left(strTemp(i, j), InStr(strTemp(i, j), strKeyword))
Else
Cells(i + 1, j + 3) = strTemp(i, j)
End If
Next
Next
End Sub
Sub 特定文字以降を削除する_複数キー指定()
Dim strTemp As Variant
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim strKeywords As Variant
Dim arrTemp As Variant
'検索キーを指定します。
strKeywords = Array("県", "府", "東京都", "北海道")
'処理対象のセルをレンジ指定します。
strTemp = Range("B2:B8")
'配列に格納された値すべてを対象に処理します。
For i = LBound(strTemp, 1) To UBound(strTemp, 1)
For j = LBound(strTemp, 2) To UBound(strTemp, 2)
'末尾が指定文字であるか判定します
For Each arrTemp In strKeywords
If InStr(strTemp(i, j), arrTemp) Then
Cells(i + 1, j + 3) = Left(strTemp(i, j), InStr(strTemp(i, j), arrTemp) + Len(arrTemp) - 1)
'検索キーの文字が複数であっても1文字しか返らないため、Len(arrTemp) - 1を追加しキーすべての文字が返るようにしています。
End If
Next
Next
Next
End Sub
Sub 特定文字以降を削除する_複数列複数キー指定()
Dim strTemp As Variant
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim strKeywords As Variant
Dim arrTemp As Variant
'検索キーを指定します。
strKeywords = Array("県", "府", "東京都", "北海道")
'処理対象のセルをレンジ指定します。
strTemp = Range("B2:C8")
'配列に格納された値すべてを対象に処理します。
For i = LBound(strTemp, 1) To UBound(strTemp, 1)
For j = LBound(strTemp, 2) To UBound(strTemp, 2)
'末尾が指定文字であるか判定します
For Each arrTemp In strKeywords
If InStr(strTemp(i, j), arrTemp) Then
Cells(i + 1, j + 4) = Left(strTemp(i, j), InStr(strTemp(i, j), arrTemp) + Len(arrTemp) - 1)
'検索キーの文字が複数であっても1文字しか返らないため、Len(arrTemp) - 1を追加しキーすべての文字が返るようにしています。
End If
Next
Next
Next
End Sub
VBAで複数列にある多種類の特定の文字以降を削除する（都道府県すべて抽出）のプログラム間違ってますよね？
動作確認はしたのでしょうか？
コードに不備がありましたことお詫び申し上げます。
確認しましたところコードにSubプロシージャの「End Sub」が2回連続されて記述がされており、
そのまま使うとエラーとなることがわかりました。
コードをサイトへ貼り付ける際にミスがあったものとなります。
不備の箇所につきましては修正をいたしましたことご報告申し上げます。