指定文字を太字にするVBAを別シートのセルを指定する構文(改良について)

いつもお世話になっております。

この度、下記のVBAの構文で指定文字を別シートを参照する形にしたい場合には、どの様な(構文)改良が必要かご教示をいただきたく質問させていただきました。

Sub 文言強調()

Dim myReg As Object
Dim m

Range("E10").Replace "　", " ", xlPart

Set myReg = CreateObject("VBScript.RegExp")
myReg.Pattern = "(パソコン|レッツノート|Lenovo|HP)"
myReg.Global = True

With Range("E10")
If myReg.test(.Value) Then

For Each m In myReg.Execute(.Value)

With .Characters(Start:=m.Firstindex + 1, Length:=m.Length).Font
.Underline = xlUnderlineStyleDouble
.Bold = True
End With

Next

End If

End With

End Sub

指定文字の
myReg.Pattern = "(パソコン|レッツノート|Lenovo|HP)"
の構文を(例えば【Sheet2】の【D2】～下方向の末尾まで)に入力されているデータを条件にしたいと考えております。

どうぞよろしくお願いいたします。

No.3 ベストアンサー 回答者： ママチャリ 回答日時： 2022/08/28 14:57

ここを

myReg.Pattern = "(パソコン|レッツノート|Lenovo|HP)"

こうする。
myReg.Pattern = Join(WorksheetFunction.Transpose(Range("D2:D" & Cells(Rows.Count, "D").End(xlUp).Row)), "|")

この回答へのお礼

ママチャリ様、回答ありがとうございます。
この様にSheet2を指定する方法があるのですね。
提示いただきました構文を組み込み理想の処理ができました。
この度はありがとうございました。

お礼日時：2022/08/31 21:59

No.6 回答者： めぐみん_ 回答日時： 2022/08/30 11:38

No.4です。

そのままかぶり過ぎるのもマナー的に恐縮なので、
ちょっと変えてみて。

With Worksheets("Sheet2")

myReg.Pattern = Join(WorksheetFunction.Transpose(.Range("D2", .Cells(Rows.Count, "D").End(xlUp))), "|")

End With

この回答へのお礼

めぐみん様、回答ありがとうございます。
With Worksheets("Sheet2")
この様にSheet名を指定するのですね。
勉強になります。
今後別シート名になることも考慮しこちらの構文も活用させていただきます。
ありがとうございました。

お礼日時：2022/08/31 22:02

No.5 回答者： tatsumaru77 回答日時： 2022/08/29 20:51

ママチャリさんのパクリです。

myReg.Pattern = "(パソコン|レッツノート|Lenovo|HP)"
を以下のように修正してください。
With Worksheets("Sheet2")
myReg.Pattern = Join(WorksheetFunction.Transpose(.Range("D2:D" & .Cells(Rows.Count, "D").End(xlUp).Row)), "|")
End With

No.4 回答者： めぐみん_ 回答日時： 2022/08/29 08:38

No.1のお礼について。

珍しいケースでしたので思わず見落としてました。
No.3 ママチャリ様の方法がスマートと思います。

コードに一部修正について（別シート指定）はお礼にコメントを入れるなりして、対応を追加お願いされてみては？

No.2 回答者： tatsumaru77 回答日時： 2022/08/28 11:38

回答ではありません。

質問の確認です。
現在の仕様
E10のセルに文字が記入されていて、「パソコン、レッツノート、Lenovo、HP」
のいずれかの文字がE10内にあれば、その文字を強調文字にしている。

改良したいこと。
E10のセルに文字が記入されていて、
Sheet2のD2～Dの末尾までに、入力されている文字の何れか
の文字がE10内にあれば、その文字を強調文字にしたい。
従って、Sheet2に
D2:パソコン
D3:レッツノート
D4:Lenovo
D5:HP
と記入されていた場合は、現在の仕様と全く同じ結果になる。

と理解したのですがあってますでしょうか？

この回答へのお礼

tatsumaru77様、質問のご確認ありがとうございます。

改良の内容ですが、tatsumaru77様のご指摘にございます内容で合っております。
よろしくお願いいたします。

お礼日時：2022/08/28 23:58

No.1 回答者： めぐみん_ 回答日時： 2022/08/28 11:16

未検証のスマホ打ちですから違っているかもですけど。

Sub 文言強調()

Dim myReg As Object
Dim m, Dim r As range

Set myReg = CreateObject("VBScript.RegExp")
myReg.Pattern = "(パソコン|レッツノート|Lenovo|HP)"
myReg.Global = True

with worksheets("Sheet2")

for each r in .range("D2", cells(rows.count, "D").end(xlup))

With r

r.Replace "　", " ", xlPart

If myReg.test(.Value) Then

For Each m In myReg.Execute(.Value)

With .Characters(Start:=m.Firstindex + 1, Length:=m.Length).Font
.Underline = xlUnderlineStyleDouble
.Bold = True
End With

Next

End If

End With

end with

End Sub

この回答へのお礼

めぐみん_様、いつもお世話になっております。
回答に重ねVBAの構築ありがとうございます。

私の分かりにくい説明で大変申し訳ございません。
補足させていただきます。
myReg.Pattern = "(パソコン|レッツノート|Lenovo|HP)"

こちらの直接指定されております文字の構文を【Sheet2】の【D2より末尾】に設定したい改良になります。

よろしくお願いいたします。

お礼日時：2022/08/29 00:09