Excelで文字を置換したいのですが

質問

A列の各セルに入っている文字列において、Bという文字があったらCに、無かったら文字を削除して空白にする、という作業を行いたいのです。

行数にして700行くらいありますので、マクロを考えました。
Replaceメソッドを使うのだと思い、ネットの記事を参考に、以下のマクロを書いてみましたが、「含まない」が機能しません。

「Bを含まない場合は削除する」というのはどのようにしたら良いでしょうか。

Sub macro9()
'Dictionaryオブジェクトの宣言
Dim myDic As Object
Set myDic = CreateObject("Scripting.Dictionary")

'Dictionaryオブジェクトの初期化、要素の追加
myDic.Add "*B", "C"
myDic.Add "<>B", ""

'Dictionaryオブジェクトを使った複数条件の置換
Dim bool As Boolean, myRange As Range
Set myRange = Range("A3:A700")
For Each Var In myDic
bool = myRange.Replace(Var, myDic(Var))
Next Var
End Sub

回答No.5

kkkkkm · ベストアンサー

> その他　*が1個もないなら、氏名全体を削除する

セルを削除なのかデータだけ削除なのかよくわからなかったので、とりあえずこの部分はデータだけ消しています。

Sub Example()
Dim c As Range

Application.ScreenUpdating = False
For Each c In Range("A3:A700")
If Not c.Value Like "*[*]" Then
c.Value = ""
ElseIf c.Value Like "*[*][*]" Then
c.Value = "新"
ElseIf c.Value Like "*[*]" Then
c.Value = "初"
End If
Next
Application.ScreenUpdating = True
End Sub

お礼

ありがとうございます。できました！！
仰る通り、削除はデータのみの削除です。

「*」が無い場合、というのは、アスタリスクを順番に処理して最後に else で持ってくるのではなくて、最初に記述できるのですね。

もし「列Ａ全体」を選んで、セルの範囲を指定しないなら、
Range("A:A")　ですね。Columns("A") 　ではダメなんですね。

ありがとうございました。
本当に助かりました。マクロが動いたときは、ちょっと感動しました。

回答No.7

imogasi

#4です。
補足有難うございます。
補足を読んでも、まだ、質問の意味が、よくわからない。再補足してはどうでしょう。
データ例（サンプル）を挙げないから、わかりにくいと思う。
下記のようなことですか。
例
A-E列　Ｂ－Ｅ列はＡ列から（関数で）導出したデータ。
山田　俊夫** 　　2 山田　俊夫**
大河内　滋男** 2 大河内　滋男**
今野　健 　　　　0 - - 今野　健
上村　重雄* 　　1 - 上村　重雄*
-はブランクセルの説明のための便宜的記述。
最終結果では、後尾の**や＊は省くのかも。
ーー
下記では、すべて下方向に式を複写。
B列B2の関数　=LEN(A2)-LEN(SUBSTITUTE(A2,"*",""))　
C列C2の関数　=IF(LEN(A2)-LEN(SUBSTITUTE(A2,"*",""))=2,A2,"")
D列D2の関数　=IF(LEN(A2)-LEN(SUBSTITUTE(A2,"*",""))=1,A2,"")
Ｅ列Ｅ２の関数　=IF(LEN(A2)-LEN(SUBSTITUTE(A2,"*",""))=0,A2,"")
ーー
Ａ列氏名の後尾の*の数でＣ，Ｄ列に振り分けた。
Ｅ列に当たるものは、考慮不要か？
ーー
これでよければ、ＶＢＡに翻案するのも簡単。

お礼

ありがとうございます。
なかなか分かりにくい説明で申し訳ありません。

1行目　列Aの標題は「氏名」です。列B以降他の列にデータはありません。
2行目から下に順に、例えば

2行目（セルA2）：山田　俊夫**
3行目（セルA3）：大河内　滋男**
4行目（セルA4）：今野　健
5行目（セルA5）：上村　重雄*

とデータが入っています。

この名前の後ろにあるアスタリスクに注目して、「*」ならば「初」に、「**」ならば「新」にそれぞれ名前を置換し、「*無し」なら氏名データの削除を行います。

結果
2行目（セルA2）：新
3行目（セルA3）：新
4行目（セルA4）：
5行目（セルA5）：初

同じ列の中で氏名を新・初・削除に置換する作業です。

つたない説明ですが、これでお分かりいただけるでしょうか・・・

回答No.6

kkkkkm

No5の続きです
セルを削除する場合はこちらで

Sub Example2()
Dim c As Range
Dim i As Long, LastRow As Long

Application.ScreenUpdating = False
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = LastRow To 3 Step -1
If Not Cells(i, "A").Value Like "*[*]" Then
Cells(i, "A").Delete xlUp
ElseIf Cells(i, "A").Value Like "*[*][*]" Then
Cells(i, "A").Value = "新"
ElseIf Cells(i, "A").Value Like "*[*]" Then
Cells(i, "A").Value = "初"
End If
Next
Application.ScreenUpdating = True
End Sub

お礼

ありがとうございます。
これも参考にさせて頂きます。
勉強させて頂きました。

回答No.4

imogasi

質問のサンプルデータと望む結果ぐらいあげて質問すること。
質問の意図が、まずわかりにくい。
ーー
こんなのエクセルの関数でもできますよ。FSOのそれもDictionaryなどで、無理すべきでないと思う。
ＥｘｃｅｌVBAのFind－Ｒｅｐｌａｃｅなど使えば済むのではないか。
ーー
関数でもできる問題では？
質問の意図を、例えば、新宿区の町名を抜出し、とかいしゃく推定した。
サンプルデータと結果　A-D列　中間作業列B,Cを使うが、
東京都新宿区西新宿 東京都新宿区西新宿 1 東京都新宿区西新宿
東京都北区 東京都新宿区中落合
東京都大田区 東京都新宿区歌舞伎町
東京都北区
東京都新宿区中落合 東京都新宿区中落合 2
東京都千代田区
東京都新宿区歌舞伎町 東京都新宿区歌舞伎町 3
東京都板橋区
東京都板橋区
A2:A１０　サンプルデータ
B2　の式　=IF(SUBSTITUTE(A2,"新宿","")=A2,"",A2)
C2の式　　=IF(B2<>"",MAX($C$1:C1)+1,"")
D２の式　　=IFERROR(INDEX($B$1:$B$10000,MATCH(ROW()-1,$C$1:$C$10000,0),0),"")

お礼

ありがとうございます。
本当に、質問の仕方が悪いと反省しております。

やりたかったことは、以下の処理です。
列「氏名」に「氏名**」「氏名*」「氏名」の3種類が入ります。
これに対して、
「氏名**」→「新」
「氏名*」→「初」
「氏名」→「」（氏名削除）
という処理をしたいのです。

例）
「青木　優**」→「新」
「井上　卓*」→「初」
「上野　葵」→「」（氏名削除）

処理としては、ワイルドカード*を使って、
「*~*~*」（氏名の後ろに*が2つある）なら氏名全体を「新」に置換する
「*~*」（氏名の後ろに*が1つある）なら氏名全体を「初」に置換する
その他　*が1個もないなら、氏名全体を削除する
という流れになります。

ワイルドカードを使おうとすると、使える関数が良く分からなくなりまして・・・
お助けいただけたら幸いです。

回答No.3

kkkkkm

> myDic.Add "*B", "C"

これはBを含むという条件ではなく「Bより前の文字列」だと思います。
結果Bを含むになりますが、含まないという条件はたぶん書けないと思います。

ABCがCCに変換されていいのでしたら
ABCはACCにでしたら
Range("A3:A700").Replace what:="B", replacement:="C"
にしてください。
セルは削除せずにデータだけ消しています。

Sub Example()
Dim c As Range

Application.ScreenUpdating = False
For Each c In Range("A3:A700")
If Not c.Value Like "*B*" Then
c.Value = ""
End If
Next
Range("A3:A700").Replace what:="*B", replacement:="C"
Application.ScreenUpdating = True
End Sub

お礼

ありがとうございます。
実行してみたときに、「含まない」以外は期待通りに動いていたのですが、自分が考えている処理をしていないのですね。
勉強不足です。

No.4 さんのご指摘通り、質問が悪いので、改めて No.4 さんへのコメントとしてやりたいことをまとめ直しました。

回答No.2

SI299792

無理して難しいコマンドを使っていませんか。
Scripting.Dictionaryなんか使わない方がいいです。
'
Option Explicit
'
Sub Macro1()
'
　　Dim Row As Long
　　Dim Cell As Range
　　Dim Change As String
'
　　For Row = Cells(Rows.Count, "A").End(xlUp).Row To 3 Step -1
　　　　Set Cell = Cells(Row, "A")
　　　　Change = Replace(Cell, "B", "")
'
　　　　If Cell = Change Then
　　　　　　Cell.Delete xlUp
　　　　Else
　　　　　　Cell = Change
　　　　End If
　　Next Row
End Sub

お礼

ありがとうございます。
ワイルドカードを含む置換をネット検索すると、かならず引っかかるサイトがありまして、その記述を元に考えるしかかないのかなぁ、と考えてしまいました。
No.4 さんがおっしゃるように、質問として不十分ですし、書き方が悪いですね。
あらためて、No.4さんにまとめます。

回答No.1

kon555

「文字を含む」で分岐させるならifとLikeでやればいいですよ。
むしろなぜオブジェクト？
https://www.relief.jp/docs/excel-vba-if-like-instr.html

お礼

コメントありがとうございます。
if で行けるのだろうと思ったのですが、ワイルドカードを含む置換をネット検索すると、どれもオブジェクトに行き着いてしまって。
勉強不足です。