[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『複数セルの異なった特定文字を一度に変換。』（Juggy）
ある列に記述されている単語を空白と置き換えています。
置換したい文字列は、セルに複数含まれている場合や
該当文字列がない場合とさまざまで、その都度、
置換で文字列を入力し、置き換える作業を繰り返します。
(モレスキン) MOLESKIN (1) → MOLESKIN
ALEX(アレックス) (14) → ALEX
Knox/ノックス (302) → Knox
ナウ オン ディズ/NOW ON DAYS(1) → NOW ON DAYS
GreetingLife(グリーティ... (5) → GreetingLife
UNITEDBEES ユナイテッドビーズ(2) → UNITEDBEES
プリマクラッセ PRIMACLASSE (1) → PRIMACLASSE
sparkle-more (1) → sparkle-more
空白 → 空白
このような表 → 置換で「(モレスキン)(1)」「(アレックス)(14)」「/ノックス(302)」「ナウ オン ディズ/(1)」などを取り除きます。
これを一度に置換する方法はないでしょうか？
よろしくお願いします。
＜ 使用 Excel：Excel2013、使用 OS：Windows10 ＞
手作業でやるなら、一度で というのは無理っぽいですね。
たとえば 変換前が （*） で 変換後になくも指定せず実行すると、(アレックス) や (14) は空白になりますが。 (オプションで 全角半角を区別するチェックや完全一致のチェックははずしておきます）
でもそのあとに、まだ削除したいものが残っていますね。 これらについては、また別途、置換が必要です。その置換も、条件が同じなら一発でしょうけど（たとえば ／＊ とか） そうでもなさそうですので、どうしても一発ということならマクロですね。
（β） 2016/07/03(日) 12:34
すみません、ちょっと編集しました。
(モレスキン) MOLESKIN (1) → MOLESKIN
ALEX(アレックス) (14) → ALEX
この2点だけでも関数で何とかなりませんでしょうか？
よろしくお願いします。
１）ワードにコピペ
２）置換
検索する文字列 [!a-zA-Z-]
置換後の文字列 空欄
ワイルドカードを使用するにチェック
３）置換結果をエクセルにコピペ
（マナ） 2016/07/03(日) 12:54
VBA
範囲を選択して実行
Sub test()
Dim r As Range
With CreateObject("VBScript.RegExp")
.Global = True: .IgnoreCase = True
.Pattern = "[^a-z-]"
For Each r In Selection
r.Value = .Replace(r.Value, "")
Next
End With
End Sub
（seiya） 2016/07/03(日) 13:05
VBAって文字は聞いたことがあるのですが、
記入していただいた構文をどのように使用したらよいのでしょうか？
難しいのでしょうか。
よろしくお願いします。
（Juggy） 2016/07/03(日) 13:11
やり方がまずいのか、ダイアログが表示され、
「[検索する文字列]に指定したパターン マッチングが正しくありません。」
と表示されました。
試した文字は
(モレスキン) MOLESKIN (1)
ALEX(アレックス) (1)
DearCards(ディアカーズ) (67)
Knox/ノックス (3)
7321Design (7321デザイン) (2)
です。
よろしくおねがいします。
（Juggy） 2016/07/03(日) 13:14
(モレスキン) MOLESKIN (1) → MOLESKIN ALEX(アレックス) (14) → ALEX
こういったパターンだけならコメントしたように
検索文字列 （*） 置き換え後の文字列 空白
これで、置換できませんか？
（β） 2016/07/03(日) 13:17
↓をコピペで試して下さい
[!a-zA-Z-]
（マナ） 2016/07/03(日) 13:22
確かに消えました。ただ、元データが変わってしまいますよね。
これはこれで、元データはセル上に残したいんです。
二つデータをコピーして、片方だけ選択し置換すればいいのでしょうか。
よろしくお願いします。
（Juggy） 2016/07/03(日) 13:24
エクセルの話ですよね？
こちらでは問題なく変換さえていますが？
サンプルファイル
http://firestorage.jp/download/e526bad6aad811459e4e067d51b6c796f00507a7
ダウンロードパスワード rd9q02yh
（seiya） 2016/07/03(日) 13:25
ファイル削除 13:46
置換したら、こんなになりました。
(モレスキン) MOLESKIN (1)
ALEX(アレックス) (1)
DearCards(ディアカーズ) (67)
Knox/ノックス (3)
7321Design (7321デザイン) (2)
↓
(モレスキンMOLESKIN (1)
ALEX(アレックス(1)
DearCards(ディアカーズ(67)
Knox/ノック(3)
7321Design (7321デザイン(2)
うーん、なぜこうなるのか分りません。
（Juggy） 2016/07/03(日) 13:29
すみません、たくさんの人が助けてくれるので、
返信が遅くなりました。
すばらしいです！ダウンロードしたファイルで確かにできました。
これがマクロというのでしょうか？
かのうでしたら、元のデータをセルに残した状態で、別のセルに置換えることなどできるのでしょうか？
よろしくおねがいします。
（Juggy） 2016/07/03(日) 13:40
>r.Value = .Replace(r.Value, "") を r(,2).Value = .Replace(r.Value, "") にすると隣のセル、3にすると1列飛ばしたセルになります。 （seiya） 2016/07/03(日) 13:44
あぁ、関数で という希望がありましたね。 元データは元データとして残し、（ ）をとりのぞいたものを別の場所に ということでしたか。 であれば、おっしゃるように、別領域にコピペして、その別領域に対して操作ということになりますね。
（β） 2016/07/03(日) 14:01
ダウンロードしたExcel ファイルに、置換したいファイルをコピペして実行しました。
でも、うまく置換できるものとそうでないものがありました。
できなかったものは、
・漢字、ひらがな、カタカナ、数字の含まれているもの。（Gクラッセ (2) → G) /（能率１６０１ (1) → 空白）
・['] が含まれてるもの。（MARK'S(マークス)(19) → MARKS）
・全角アルファベットのもの。（ＡＳＨ (1) → 空白）
・かっこの中がアルファベットのもの。（EVERYSHOW(KR) (1) → EVERYSHOWKR）
・スペースが含まれているもの。（MadeHeart | Buy handmade goods (1) → MadeHeartBuyhandmadegoods）
でした。
すみません。やはり難しいでしょうか。よろしくおねがいします。
（Juggy） 2016/07/03(日) 14:05
それをどのように変換したのか不明ですが,以下に変更してみてください。
Sub test()
Dim r As Range
With CreateObject("VBScript.RegExp")
.Global = True: .IgnoreCase = True
.Pattern = "[^a-zＡ-Ｚ' -]|\([^\)]+\)"
For Each r In Selection
r(, 2).Value = Application.Trim(.Replace(r.Value, ""))
Next
End With
End Sub
（seiya） 2016/07/03(日) 14:19
横から失礼。
>>すみません。やはり難しいでしょうか。よろしくおねがいします。
削除する条件を漏れなく正確に言葉でアップすれば、なんとでもなります。 サンプルを提示して、こんな感じ というような説明だけでは、回答側の要件理解とJuggyさんの希望要件が 必ずしも一致しないことになりますから。
マクロ処理にしろ、エクセルやワードの操作による処理にしろエクセル関数処理にしろ、何をどうしたいかが わからないと、いつまでたっても、こういったばあい、こうならない！という繰り返しになりますよ。
（β） 2016/07/03(日) 14:24
おっしゃる通りです。
このような質問をいままでにしたことがありませんでしたので、
どのように質問すればよいか分りませんでした。
本当に申し訳ありません。
もう一度まとめさせていただきます。
まず、サンプルファイルを見ていただけますか？
サンプルファイル
http://firestorage.jp/download/acdd66a4b8b2e60a2d55ea63ba1290b09d804d26
ダウンロードパスワード q5edmnqz
このファイルでやりたいことは、
[カテゴリー２]＋[/]＋[カテゴリー３]＋[/]＋[カテゴリー４] を
「キーワード」のセルに右上のようにまとめたいのです。
日記帳のカテゴリの場合は、[カテゴリ４]がありませんので、
それを考慮して「キーワード」にまとめたいです。
こんな私に、ご丁寧にたくさんの方々がメッセージをしていただけて、
とてもうれしく思います。
お気に召された部分がありましたら、申し訳ございませんでした。
よろしくお願い致します。
（Juggy） 2016/07/03(日) 15:00
Juggyさん アップしたコードは試したの？ 試しもしないなら、これ以上は無しですね.
（seiya） 2016/07/03(日) 15:17
すみません、コードの編集方法が分らないので、調べながらやってみているところです。
終わりましたら、ご報告させていただきます。
（Juggy） 2016/07/03(日) 15:20
初めてマクロをさわるので、正しい動作なのか分りませんが、
となりのBのセルに表示がされることを確認しました。
これで動作はあっているでしょうか？
（Juggy） 2016/07/03(日) 15:27
UDF (ユーザー定義関数)
セルに
=RemoveBrackets(B4:F4)
Function RemoveBrackets(rng As Range) As String
Dim r As Range, txt As String
If rng(1).Value Like "日記帳*" Then
If Application.CountA(rng.Resize(, 3)) = 3 Then
txt = Join(Application.Index(rng.Resize(, 3).Value, 1, 0), "")
End If
ElseIf rng(, 6).Value <> "" Then
txt = Join(Application.Index(rng.Value, 1, 0), "")
End If
With CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "\([^)]+\)"
RemoveBrackets = .Replace(txt, "")
End With
End Function
http://firestorage.jp/download/84c19f38bf844f9d717f00735c7f040e3d942472
ダウンロードパスワード y55zd05r
（seiya） 2016/07/03(日) 16:02
もう、返事をいただけないと思ってしまいました。
さっそく、先ほど試した通りに書き換えてみます。
では、後ほど。
（Juggy） 2016/07/03(日) 16:11
まずファイルをダウンロードして確認してください。 数式は I 列に入力されていますので結果を照合してください。
改良すべき点がありますのでコードを以下に変更してください。
Function RemoveBrackets(rng As Range) As String
Dim r As Range, txt As String
If rng(1).Value Like "日記帳*" Then
If Application.CountA(rng.Resize(, 3)) = 3 Then
txt = Replace(Join(Application.Index(rng.Resize(, 3).Value, 1, 0), ""), ChrW(160), "")
End If
ElseIf rng(, 6).Value <> "" Then
txt = Replace(Join(Application.Index(rng.Value, 1, 0), ""), ChrW(160), "")
End If
With CreateObject("VBScript.RegExp")
.Global = True
.Pattern = " *\([^)]+\) *"
RemoveBrackets = .Replace(txt, "")
End With
End Function
（seiya） 2016/07/03(日) 16:15
>お気に召された部分がありましたら、申し訳ございませんでした。
？？
おき‐に‐め・す【御気に召す】 >［連語］「気に入る」「好む」の尊敬語。「お客様の―・すかどうか」「こちらのほうが―・しましたか http://dictionary.goo.ne.jp/srch/all/%E3%81%8A%E6%B0%97%E3%81%AB%E5%8F%AC%E3%81%99/m0u/ （日本語適正化委員会） 2016/07/03(日) 16:39
「お気に障りましたら」のつもりでした。
（Juggy） 2016/07/03(日) 16:46
というのも、
24行目の「Artemis/アーティミス (10)」や、
155行目の「プリマクラッセ PRIMACLASSE (1)」などは
理由はわかりませんが、上手に置換ができないようです。
でも、ほんの少しだけなので、手作業で直せばいいかなと思ってます。
それから、質問ですが、
カテゴリ1,2,3,4 に別のカテゴリを入力すると、
I列に結果表示がされません。
ここでは、カテゴリ2 に「付箋 (8,075)」
カテゴリ3 に各ブランド名をコピペしました。
もう一つは、カテゴリ2 に「ノート (19,019)」
カテゴリ3 に「横罫 (3,951)」、カテゴリ4 に各ブランド名をコピペしました。
どのように対処すれば表示されるようになりますか？
こちらについても、うまく説明できているか不安があるので、
ファイルをアップロードしました。
サンプル
http://firestorage.jp/download/0a0d602d7247db5fc0432e5e103eb5f25494cab2
ダウンロードパスワード 075n0qm4
よろしくお願いします。
（Juggy） 2016/07/03(日) 17:58
連結スラッシュの他にセル内にもスラッシュがあるので、シートをこんな感じに変更できませんか？
Function RemoveBrackets(rng As Range) As String
Dim r As Range, txt As String, x
If rng(1).Value Like "日記帳*" Then
If Application.CountA(rng.Resize(, 2)) = 2 Then
txt = Join(Evaluate("index(substitute(substitute(" & rng.Resize(, 2).Address & ",""/"",char(2)),char(160),""""),,)"), "/")
End If
ElseIf rng(, 3).Value <> "" Then
txt = Join(Evaluate("index(substitute(substitute(" & rng.Address & ",""/"",char(2)),char(160),""""),,)"), "/")
End If
With CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "(" & Chr(2) & "[^(]+)? *\([^)]+\) *"
RemoveBrackets = .Replace(txt, "")
End With
End Function
http://firestorage.jp/download/7694c914815df15137bd7ceca081f1b35ce9bf79
ダウンロードパスワード b8meuq5f （ seiya） 2016/07/03(日) 18:35 ファイル/コード共に変更 18:45
セル内のスラッシュは別になくてもかまいません。
はじめ、関数でやろうとしていたので、スラッシュを入れていました。
これから新たにカテゴリをコピペする場合（例えばシートの中にあるルーズリーフのカテゴリ）ですが、
どのようにペーストすればキーワードの結果が反映されるようになりますか？
また、ダウンロードしたファイルの216行〜419行「付箋」カテゴリについて、
キーワードが表示されていないため、これをどうしたら表示できるようになるか分りません。
何度も申し訳ありません。
（Juggy） 2016/07/03(日) 19:12
G列に入力されている数式をそのままE列に移行してください。
1) G4を選択、数式バーをクリックして数式(=RemoveBrackets(B4:D4)になっているはず)をコピー 2) E4を選択、数式バーをクリックして貼り付け 3) E4をフィルダウンする
では？ （seiya） 2016/07/03(日) 19:35
「付箋」?
期待値が表示されていた？ こういうこと？
Function RemoveBrackets(rng As Range) As String
Dim r As Range, txt As String, x
If (rng(1).Value Like "日記帳*") + (rng(1).Value Like "付箋*") Then
If Application.CountA(rng.Resize(, 2)) = 2 Then
txt = Join(Evaluate("index(substitute(substitute(" & rng.Resize(, 2).Address & ",""/"",char(2)),char(160),""""),,)"), "/")
End If
ElseIf rng(, 3).Value <> "" Then
txt = Join(Evaluate("index(substitute(substitute(" & rng.Address & ",""/"",char(2)),char(160),""""),,)"), "/")
End If
With CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "(" & Chr(2) & "[^(]+)? *\([^)]+\) *"
RemoveBrackets = .Replace(txt, "")
End With
End Function
（seiya） 2016/07/03(日) 21:31
あのあと、再度G列に入力されている数式をそのままE列に移行したところ
ほとんどうまく表示されました！
あとはこれらが正しく表示されれば完璧です！
以下、正しく表示させたいリストです。
ダウンロードファイルと合わせてご確認いただけると幸いです。
[列] [正しい表示]
33：ノート/横罫/Fringe Studio 51：ノート/横罫/Leuchtturm1917 72：ノート/横罫/Paper-Oh 75：ノート/横罫/Pent 92：ノート/横罫/UNITEDBEES 165：ノート/横罫/Davinci 220：付箋/Aimez le style 230：付箋/Coloring Book 246：付箋/HI MOJIMOJI 255：付箋/junglegym 278：付箋/paperable 378：付箋/デングオン 408：付箋/マークスフィア 445：日記帳/DELFONICS 504：日記帳/UNITEDBEES 561：日記帳/PRIMACLASSE 562：日記帳/ペーパーブランクス
http://firestorage.jp/download/b42d693f42cd9ba28aa287c1374325f92f7b7a32
ダウンロードパスワード y1b38dc0
よろしくおねがいします！
（Juggy） 2016/07/04(月) 06:30
これで確認して下さい
Function RemoveBrackets(rng As Range) As String
Dim r As Range, txt As String, x
If (rng(1).Value Like "日記帳*") + (rng(1).Value Like "付箋*") Then
If Application.CountA(rng.Resize(, 2)) = 2 Then
txt = Join(Evaluate("index(substitute(substitute(" & rng.Resize(, 2).Address & ",""/"",char(2)),char(160),""""),,)"), "/")
End If
ElseIf rng(, 3).Value <> "" Then
txt = Join(Evaluate("index(substitute(substitute(" & rng.Address & ",""/"",char(2)),char(160),""""),,)"), "/")
End If
With CreateObject("VBScript.RegExp")
.Global = True: .IgnoreCase = True
.Pattern = "(" & Chr(2) & "[^(]+)? *[（(\[][^)（）\]]+[）)\]]"
txt = .Replace(txt, "")
.Pattern = "([a-z" & Chr(2) & "]) *[亜-熙ぁ-んァ-ヶ・ー]+|[亜-熙ぁ-んァ-ヶ・ー]+ *([a-z])|／[亜-熙ぁ-んァ-ヶ・ー]+"
If .test(txt) Then txt = .Replace(txt, "$1$2")
RemoveBrackets = txt
End With
End Function
http://firestorage.jp/download/b33e91ead4bed87b0294fbc3d47991bcfff8ef4a
ダウンロードパスワード tn51b61b （seiya） 2016/07/04(月) 07:33
確認させていただきました。うまく機能しました。
ところが、まったく別のカテゴリをコピペすると、このマクロでは機能しないのでしょうか？
というのも、新たにカテゴリ1,2,3,4 に 例えば、
カテゴリ1 に「おもちゃ」
カテゴリ2 に「ラジコン」
カテゴリ3 に「ヘリコプター」
カテゴリ4 に 「ブランド名」
とすべてをコピペしたときに、キーワードに置換がされませんでした。
なにか、特別なコピペのやり方とかがあるのでしょうか？
よろしくおねがいします。
（Juggy） 2016/07/04(月) 21:30
カテゴリというのが見えてこないけど、 単純にB:D列でB:Cが空白でない場合、B:D列の空白でない列の文字列を連結する ということで...
Function RemoveBrackets(rng As Range) As String
Dim r As Range, txt As String, x
With rng
If Application.CountA(.Resize(, 2)) = 2 Then
txt = Join(Filter(.Parent.Evaluate("if(" & .Address & "<>"""",substitute(substitute(" & .Address & _
",""/"",char(2)),char(160),""""),char(2))"), Chr(2), 0), "/")
End If
End With
With CreateObject("VBScript.RegExp")
.Global = True: .IgnoreCase = True
.Pattern = "(" & Chr(2) & "[^(]+)? *[（(\[][^)（）\]]+[）)\]]"
txt = .Replace(txt, "")
.Pattern = "([a-z" & Chr(2) & "]) *[亜-熙ぁ-んァ-ヶ・ー]+|[亜-熙ぁ-んァ-ヶ・ー]+ *([a-z])|／[亜-熙ぁ-んァ-ヶ・ー]+"
If .test(txt) Then txt = .Replace(txt, "$1$2")
RemoveBrackets = txt
End With
End Function
（seiya） 2016/07/05(火) 03:40
列を挿入したあとにキーワードセルへ置換されず悩んでました。前回のプログラムではいけなかったのですが、今回はセルEに「=RemoveBrackets(B*:D*)」をコピペすればいけました！
それに気が付かず、固まってしまいました。。
提供いただいた数式？が何を書いているのかまったく分かりませんが、VBAを勉強したくなりました。
少しずつ手を加えて、それが形になっていくことが面白かったです。
seiya さんのおすすめのサイト、本などがありましたらご紹介おねがいします。
いままで本当にありがとうございました！
また相談したいことがありましたら、是非よろしくおねがいします！
それでは、失礼します。
（Juggy） 2016/07/05(火) 22:25
最後のコードでOKだったようですね。
VBAの本は読んだことがありません。(たまに書店で立ち読み程度) ネットで検索すればいろいろなサイトがあり、初心者を対象にしたものも多数ありますよ？
今回は複雑な文字列処理をするために初心者の方には理解しずらいコードになってしまいましたが もっと簡単なものから始めてください。
それと、ExcelのVBAを理解するには、まずExcelそのものの理解を深めることが重要かと思います。
（ seiya） 2016/07/06(水) 07:06
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.