文字列リストと部分的な完全一致で連続置換したい

質問

エクセルのマクロで質問です。

今、下記のようなシートを持つエクセルデータがあります。

****************************************************************************
シート1
・A列：別途抽出したファイルサーバーのディレクトリ名が1000行程度記載
　　例 A1=\\サーバー1\フォルダ1\フォルダ2\フォルダ3
　　 　 A2=\\サーバー1\フォルダ1\フォルダ4
　　 　 A3=\\サーバー2\フォルダ2\フォルダ5\フォルダ6\フォルダ7
・B列：A列のコピー

シート2
・A列：シート1のディレクトリ名から名前を変更したいフォルダ名を200個程度記載
　　例 A1=フォルダ2
　　 　 A2=フォルダ4
　　 　 A3=フォルダ7
・B列：A列に対して変更後の名前を記載
　　例 B1=フォルダX
　　 　 B2=フォルダY
　　 　 B3=フォルダZ
※A1とB1、A2とB2のように対比は1対1
****************************************************************************

シート1のB列に対して、シート2の文字列リストを元に連続して置換がしたいのです。
ですが単に置換するだけでなく、ディレクトリ内のフォルダ名を1つの単位として完全一致する場合のみ置換させたいのです。
（\で囲まれた部分 もしくは末端の場合は\の右側の単位で、大文字小文字や半角全角も判定）

例えば上記の例で、シート2で「フォルダ2=内部、フォルダ4=国内部品、フォルダX=Naibu、フォルダY=KokunaiBuhin」だった場合、単に置換するとシート1のディレクトリでは「フォルダ2=Naibu、フォルダ4=国Naibu品」となってしまう可能性があります。

また、フォルダ1が「内部構造」のような名前だと文字列リストに記載がなくても「Naibu構造」と置換されてしまう可能性もあります。

これを確実に「フォルダ1=内部構造、フォルダ2=Naibu、フォルダ4=KokunaiBuhin」としたいのです。

過去の質問などから近いものはいくつか見当たるのですが、セルの完全一致でなく文字列内の部分的な完全一致となると見つけられませんでした。

マクロが苦手なので得意な方にご教授願いたいと思っています。

回答No.1

keithin · ベストアンサー

sub macro1()
　dim h as range
　dim r1 as long, r2 as long

　worksheets("Sheet1").select
　r1 = range("A65536").end(xlup).row
　r2 = worksheets("Sheet2").range("A65536").end(xlup).row

’下拵え
　with range("C1:C" & r1)
　　.formula = "=B1&IF(RIGHT(B1)=""\"","""",""\"")"
　　.value = .value
　end with

’置換
　for each h in worksheets("Sheet2").range("A1:A" & r2)
　　range("C:C").replace what:="\" & h.value & "\", _
　　　replacement:="\" & h.offset(0, 1).value & "\", _
　　　lookat:=xlpart, matchcase:=true, matchbyte:=true
　next

’片付け
　with range("D1:D" & r1)
　　.formula = "=LEFT(C1,LEN(C1)-(RIGHT(B1)<>""\""))"
　　range("B1:B" & r1).value = .value
　end with
　range("C:D").delete shift:=xlshifttoleft
end sub

みたいな。

＃余談
＞マクロが苦手なので

マクロを考える前にまずアナタが自分の手を動かして，エクセルをどうやって操れば目的を達成できるのか手順を考えてみると，マクロとかも簡単に書けます。
エクセルの動かし方とか判らないでマクロだけ頑張っても，まぁ出来ないとは言いませんが，ハマルだけです。

お礼

ありがとうございます。
やりたいことができました！！

ご指定の通りマクロって手でやることの自動化ですもんね。
マクロだけでなくエクセルの使い方や考え方についても学んでいけたらと思っています。

本当に助かりました。