指定した文字を始点にスペースまでに下線を引くVBA

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

この度、指定した文字を始点にスペースまで下線を引く
VBAについてご教示いただきたく質問させていただきました。

添付した画像を例としますと、セル内のみかんを始点にスペースまで
めろんを始点にスペースまでに下線を引きたいと思います。
マクロの記録を行ったところ
Sub Macro1()
'
' Macro1 Macro

Range("C3").Select
ActiveCell.FormulaR1C1 = "りんご みかん0120-1234-5678 めろん03-1234-5678 なし"
With ActiveCell.Characters(Start:=1, Length:=4).Font
.Name = "游ゴシック"
.FontStyle = "標準"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With ActiveCell.Characters(Start:=5, Length:=17).Font
.Name = "游ゴシック"
.FontStyle = "標準"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleSingle
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With ActiveCell.Characters(Start:=22, Length:=1).Font
.Name = "游ゴシック"
.FontStyle = "標準"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With ActiveCell.Characters(Start:=23, Length:=15).Font
.Name = "游ゴシック"
.FontStyle = "標準"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleSingle
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("A1").Select
End Sub

となりました。

Characters(Start:=1, Length:=4)
ここの記述が重要だと思うのですが、
ここからどの様な形に組み込むのかのご教示をお願いします。

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

No.3 ベストアンサー 回答者： めぐみん_ 回答日時： 2021/05/23 06:39

質問文をそのまま利用させて頂いたので。

＞With Range("C3")
＞.Value = "りんご みかん0120-1234-5678 めろん03-1234-5678 なし"
＞こちらの構文もセルの内容に合わせ変えなくてはならないのでしょうか？

With Range("C3")
' .Value = "りんご みかん0120-1234-5678 めろん03-1234-5678 なし" ←この行は削除しても構いません。
' 既にデータが入力されているのであれば。

If myReg.Test(.Value) Then

No.2 回答者： めぐみん_ 回答日時： 2021/05/22 09:35

一例です。

Sub megu()
Dim myReg As Object
Dim m

Set myReg = CreateObject("VBScript.RegExp")
myReg.Pattern = "(みかん|めろん)\S+"
myReg.Global = True

With Range("C3")
.Value = "りんご みかん0120-1234-5678 めろん03-1234-5678 なし"

If myReg.Test(.Value) Then

For Each m In myReg.Execute(.Value)

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

Next

End If

End With

End Sub

この回答へのお礼

めぐみんさん、回答ありがとうございます。

こちらのVBAで「みかん」と「めろん」を始点に
スペースまでに下線を引く処理ができました。
ありがとうございます。

重ねて質問なのですが、例えばC3の内容にりんごとなしの
入力ではなく、異なる文字データが入力されている場合は
With Range("C3")
.Value = "りんご みかん0120-1234-5678 めろん03-1234-5678 なし"
こちらの構文もセルの内容に合わせ変えなくてはならないのでしょうか？
理想とします処理は下線を引く処理だけにしたいと思っております。

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

お礼日時：2021/05/22 22:49

No.1 回答者： めぐみん_ 回答日時： 2021/05/22 08:31

＞指定した文字を始点にスペースまで下線を引く

１．指定とはどのようにして与える予定？
２．下線さえ引ければ良いと言う事？
３．スペースまでとあるけど『その手前』になるのかな？