[[20170322163311]]　『リストにある単語を赤くする』（まーちゃん）　ページの最後に飛ぶ

『リストにある単語を赤くする』（まーちゃん）

いちご
りんご
オレンジ

というリストがシート「リスト」のA列にあって
本文というシートのA1に

きょうはいちごとスイカがやすいよ。オレンジも激安

という文章をいれてマクロを動かすと

いちごとオレンジが赤色に代わるようになるにはどうすればよいでしょうか？

どなたかご教示いただければ幸いです。

＜使用 Excel：Excel2016、使用 OS：unknown ＞

 少し難しいかもしれませんが　正規表現を使うとこんな感じになります。

 Sub Sample()
    Dim myStr As String
    Dim reg As Object
    Dim shL As Worksheet
    Dim mt As Object
    Dim pat As String

    Set shL = Sheets("リスト")
    Set reg = CreateObject("VBScript.RegExp")
    reg.Global = True
    reg.Pattern = "([\$\?\*\+\.\|\{\}\\\[\]\(\)])" 'エスケープ用
    pat = Join(WorksheetFunction.Transpose(shL.Range("A2", shL.Range("A" & Rows.Count).End(xlUp))), vbTab)
    reg.Pattern = Replace(reg.Replace(pat, "\$1"), vbTab, "|")

    With Sheets("本文").Range("A1")
        .Font.ColorIndex = xlAutomatic
        For Each mt In reg.Execute(.Value)
            .Characters(mt.firstindex + 1, mt.Length).Font.Color = vbRed
        Next
    End With

 End Sub

（β） 2017/03/22(水) 17:28

 ↑　リストに登録された文字列の中に正規表現の制御文字があった場合のエスケープ処理を加えましたが
 　　そういった文字は絶対にないということなら、コードは以下のように　少しシンプルになります。
 　　制御文字は　^　　$　　?　　*　　+　　.　　|　　{　　}　　\　　[　　]　　(　　)
 　　これら 14文字です。

 　　なお、リストシートのリストが A1 から始まっているなら、コード内の A2 を A1 に変更してください。

 Sub Sample2()
    Dim myStr As String
    Dim reg As Object
    Dim shL As Worksheet
    Dim mt As Object

    Set shL = Sheets("リスト")
    Set reg = CreateObject("VBScript.RegExp")
    reg.Global = True
    reg.Pattern = Join(WorksheetFunction.Transpose(shL.Range("A2", shL.Range("A" & Rows.Count).End(xlUp))), "|")

    With Sheets("本文").Range("A1")
        .Font.ColorIndex = xlAutomatic
        For Each mt In reg.Execute(.Value)
            .Characters(mt.firstindex + 1, mt.Length).Font.Color = vbRed
        Next
    End With

 End Sub

（β） 2017/03/22(水) 18:02

 正規表現を使わず　ＶＢＡ標準コードのみで書いてみました。

 Sub Sample3()
    Dim Target As Range
    Dim c As Range
    Dim shL As Worksheet
    Dim x As Long
    Dim n As Long

    Set shL = Sheets("リスト")
    Set Target = Sheets("本文").Range("A1")
    Target.Font.ColorIndex = xlAutomatic

    For Each c In shL.Range("A2", shL.Range("A" & Rows.Count).End(xlUp))
        x = 1
        Do
            n = InStr(x, Target, c.Value)
            If n = 0 Then Exit Do
            Target.Characters(n, Len(c.Value)).Font.Color = vbRed
            x = n + Len(c.Value) - 1
        Loop
    Next

 End Sub

（β） 2017/03/22(水) 18:52

コメント返信：

[ 一覧(最新更新順) ]

[[20170322163311]] 『リストにある単語を赤くする』（まーちゃん） ページの最後に飛ぶ

[[20170322163311]]　『リストにある単語を赤くする』（まーちゃん）　ページの最後に飛ぶ