こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

投稿日時 - 2019-04-15 00:11:07

QNo.9606850

困ってます

質問者が選んだベストアンサー

> その他 *が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

投稿日時 - 2019-04-15 21:35:20

お礼

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

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

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

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

投稿日時 - 2019-04-15 21:54:59

ANo.5

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(7)

ANo.7

#4です。
補足有難うございます。
補足を読んでも、まだ、質問の意味が、よくわからない。再補足してはどうでしょう。
データ例(サンプル)を挙げないから、わかりにくいと思う。
下記のようなことですか。

A-E列 B-E列はA列から(関数で)導出したデータ。
山田 俊夫**  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,"")
E列E2の関数 =IF(LEN(A2)-LEN(SUBSTITUTE(A2,"*",""))=0,A2,"")
ーー
A列氏名の後尾の*の数でC,D列に振り分けた。
E列に当たるものは、考慮不要か?
ーー
これでよければ、VBAに翻案するのも簡単。

投稿日時 - 2019-04-15 22:08:09

お礼

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

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

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

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

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

結果
2行目(セルA2):新
3行目(セルA3):新
4行目(セルA4):
5行目(セルA5):初

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

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

投稿日時 - 2019-04-16 00:29:14

ANo.6

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

投稿日時 - 2019-04-15 21:48:46

お礼

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

投稿日時 - 2019-04-15 22:00:40

ANo.4

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

投稿日時 - 2019-04-15 16:40:55

お礼

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

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

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

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

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

投稿日時 - 2019-04-15 21:06:57

ANo.3

> 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

投稿日時 - 2019-04-15 09:36:03

お礼

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

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

投稿日時 - 2019-04-15 20:56:17

ANo.2

無理して難しいコマンドを使っていませんか。
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

投稿日時 - 2019-04-15 05:35:17

お礼

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

投稿日時 - 2019-04-15 20:52:59

ANo.1

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

投稿日時 - 2019-04-15 00:58:29

お礼

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

投稿日時 - 2019-04-15 20:45:08

あなたにオススメの質問