文字色とスタイルの変更マクロ | エクセルマクロ(VBA)実践蔵(じっせんぐら)

トップ項目一覧

検索した文字列と一致する位置の文字色やスタイル(普通/太字/斜字)を変更します。

セルの中の一部分のフォントスタイルを変更していくことは、手動では大変なので、マクロにしてみました。

例として、エディタのように決められたキーワードの色を変えます。正規表現にも対応させました。

入力データは以下の表になります。

A列が検索する文字列であり、一致した場合に適応させるフォント色の情報とフォントスタイル(普通/太字/斜字)を含んでいます。

コードで色の変更を行うとRGBを設定する必要があるため、セルからの取得の方が調べる必要がなくて楽に設定できます。

正規表現のON/OFF指定をB列からしています。

C列の単語検索ON/OFFは、英単語の綴りの中に含まれるような文字列に対して、単語内部分一致を検出するならOFF、単語としての検索ならONに設定します。

例えば、「Dim ABCString As String」という文字列に対して、「String」を文字列検索した場合に、単語検索がOFFなら、「Dim ABCString As String」と２箇所のStringが検出対象となり、単語検索がONなら「Dim ABCString As String」と、一か所のみが検出されます。

検索文字列の前後が、スペースや行頭、行末、括弧()、イコールの場合に単語として扱っています。

検索文字列と一致する文字の色やスタイルを変更するマクロ

変更するシートオブジェクトを引数に渡す

今回は、同じエクセルマクロ有効ブック内のシートに対して、変更をかけています。

マクロの実行から呼び出すのは、「文字色変更シートの指定」になります。

 
Sub 文字色変更シートの指定() 
     
    Call 検索リスト_フォント変更(ThisWorkbook.Worksheets("Sheet1")) 
     
End Sub 

引数に、シート名「Sheet1」のシートオブジェクトを渡しています。複数シートならループさせたり、ActiveSheetに変更したりは適宜行ってください。別ブックのシートオブジェクトでも大丈夫です。

検索ワードリストでループして、文字色やフォントスタイルの変更を行うマクロ

 
Sub 検索リスト_フォント変更(WSht As Worksheet) 
     
    Dim Rng As Range 
    Dim FindListRng As Range 
    Dim SetSht As Worksheet 
             
    '検索ワードリストのあるシートオブジェクトを設定 
    Set SetSht = Worksheets("Setting") 
     
    'A列(使用中の列の左端の列)を取得 
    Set FindListRng = SetSht.Range(SetSht.UsedRange.Columns(1).Address) 
     
    For Each Rng In FindListRng 
    '検索文字列リストでループ 
     
        If Rng.Row > 1 And Not Rng.Value = "" Then 
        'ループ参照セルが2行目以降、かつ、検索文字列セルが空でなければ、 
                 
            If Rng.Offset(0, 1).Value = "" Then 
            '検索文字列の右隣セルに情報がない（正規表現指定なし）の場合 
                 
                If Rng.Offset(0, 2).Value = "ON" Then 
                '検索文字列の二つ右隣セル(単語検索)がONか確認する 
                 
                    '文字色を変更する関数の呼び出し 
                    '引数1 必須 対象シートオブジェクト 
                    '引数2 必須 検索文字列(セル情報) 
                    '引数3 Optional 正規表現検索 指定なしはOFF(False) 
                    '引数4 Optional 単語検索 ON(True) 
                    Call フォント変更(WSht, Rng, Word:=True) 
                                         
                Else 
                     
                    '文字色を変更する関数の呼び出し 
                    '引数1 必須 対象シートオブジェクト 
                    '引数2 必須 検索文字列(セル情報) 
                    '引数3 Optional 正規表現検索 指定なしはOFF(False) 
                    '引数4 Optional 単語検索 指定なしはOFF(False) 
                    Call フォント変更(WSht, Rng) 
                     
                End If 
             
            Else 
                '正規表現指定あり 
                 
                If Rng.Offset(0, 1).Value = "ON" Then 
                '正規表現指定がONの場合 
                     
                    '文字色を変更する関数の呼び出し 
                    '引数1 必須 対象シートオブジェクト 
                    '引数2 必須 検索文字列(セル情報) 
                    '引数3 Optional 正規表現検索 ON(True) 
                    '引数4 Optional 単語検索 指定なしはOFF(False) 
                    Call フォント変更(WSht, Rng, True) 
                     
                Else 
                '正規表現指定がOFFの場合 
                 
                    '文字色を変更する関数の呼び出し 
                    '引数1 必須 対象シートオブジェクト 
                    '引数2 必須 検索文字列(セル情報) 
                    '引数3 Optional 正規表現検索 指定無しはOFF(False) 
                    '引数4 Optional 単語検索 指定なしはOFF(False) 
                    Call フォント変更(WSht, Rng) 
                     
                End If 
            End If 
        End If 
    Next 
     
    Set Rng = Nothing 
    Set FindListRng = Nothing 
    Set SetSht = Nothing 
 
End Sub 

検索ワードリストでループして、文字色やフォントスタイルの変更を行うマクロの解説

表から検索ワードや検索条件の設定値を読み込んで、フォント変更関数を呼び出しています。フォントの変更を行っているのは関数内になります。

セルからの指定をON/OFFにして、フォント変更関数へは、True/Falseで指定しているため、その変換を行っています。

フォント変更を行いたい検索文字列が一つなら、フォント変更関数を呼び出せばよく、必ずしもセルから指定する必要はありません。呼び出し方の例になると思ったので、あえてパターン分けをしてコメントを増やしました。

セルからTrue/Falseで受け取れば、ここのパターン分けは不要です。

引数の検索文字列と一致する箇所のフォント変更を行うマクロ

 
'************************************************* 
' フォント変更 該当箇所の文字色を変更する 
' 引数1 Wst      :変更対象のシートオブジェクト 
' 引数2 TextRng  :検索文字列と指定フォント 
' 引数3 Reg      :正規表現の有無(デフォルトは、無し) 
' 引数4 Word     :単語検索の有無(デフォルトは、無し) 
' *********************************************** 
Function フォント変更(Wst As Worksheet, TextRng As Range, _ 
                      Optional Reg As Boolean = False, _ 
                      Optional Word As Boolean = False) As Boolean 
     
    Dim Rng As Range 'ループ用 
    Dim pos As Long '検索一致位置 
    Dim leng As Long '検索して一致した文字列の長さ 
    Dim stPos As Long 'セル内文章の検索開始位置 
    Dim str As String '正規表現検索で一致した文字列 
    Dim TextStr As String '検索文字列 
     
    If Word = True Then 
    '単語検索がONの場合、正規表現検索をする 
         
        '引数の正規表現検索オプションをTrueに変更する 
        Reg = True 
         
        '正規表現の書き方で(A|B|C|D)は、A Or B Or C Or Dを意味する 
        '今回は、Aが空白文字(スペースやタブ、セル内改行)\s、 
        '　Bが行頭記号^、又は、行末記号$、 
        '　Cが全角スペース、Dが記号(括弧()やイコール=を含む)[ -/:-@[-`{-~] 
        '　上記のもので検索文字列を挟む 
         
        '検索文字列を作成 
        TextStr = "(\s|^|　|[ -/:-@[-`{-~])" & TextRng.Value & "(\s|$|　|[ -/:-@[-`{-~])" 
         
    Else 
    '単語検索がOFFの場合 
         
        '検索文字列を設定 
        TextStr = TextRng.Value 
     
    End If 
         
    '指定シートのすべての文章を対象としてループ 
    For Each Rng In Wst.UsedRange 
                
        For stPos = 1 To Len(Rng.Text) 
        '文字列の先頭から終わりまで 
        '一つのセル内に検索一致箇所が複数存在する可能性があるため、一致した箇所の一つ後ろにstPosを移動させ、 
        '残り後ろの文章で再検索するためのループ（検索文字列を含む限りループし、含まなければループは抜ける） 
         
            '正規表現検索なしの場合 
            If Reg = False Then 
                 
                '通常検索 
                pos = InStr(stPos, Rng.Value, TextStr, vbTextCompare) 
                 
                '文字数を取得 
                leng = Len(TextStr) 
                 
            Else 
                '正規表現検索 
                str = RExp_FindStr(stPos, Rng.Value, TextStr) 
                 
                If str = "" Then 
                '見つからなかった場合 
                    pos = 0 
                 
                Else 
                '見つかった場合 
                 
                    If Word = True Then 
                    '単語検索の場合 
                                 
                        '正規表現検索で一致した文字列の位置を取得 
                        pos = InStr(stPos, Rng.Value, str, vbTextCompare) 
                        '単語の位置の補正（単語前に記号がある場合、除外するため） 
                        pos = pos + InStr(1, str, TextRng.Value, vbTextCompare) - 1 
                        '文字数を取得 
                        leng = Len(TextRng.Value) 
                    Else 
                    '正規表現検索 
                         
                        '正規表現検索で一致した文字列の位置を取得 
                        pos = InStr(stPos, Rng.Value, str, vbTextCompare) 
                        '文字数を取得 
                        leng = Len(str) 
                    End If 
                End If 
            End If 
             
            If pos > 0 Then 
                '一致する文字列が存在する 
                 
                '検索文字のセル情報に従って、太字(True/False)を設定 
                Rng.Characters(pos, leng).Font.Bold = TextRng.Font.Bold 
                '検索文字のセル情報に従って、斜字(True/False)を設定 
                Rng.Characters(pos, leng).Font.Italic = TextRng.Font.Italic 
                '検索文字のセル情報に従って、フォント色を設定 
                Rng.Characters(pos, leng).Font.Color = TextRng.Font.Color 
                                                
                '検索開始位置をずらす。残りの文章で再検索 
                stPos = pos + leng - 1 
                 
            Else 
                Exit For 
                 
            End If 
             
        Next 
         
    Next 
     
    フォント変更 = True 
    Set Rng = Nothing 
     
End Function 

引数の検索文字列と一致する箇所のフォント変更を行うマクロの解説

指定シート内のすべてのセル内の文字列を対象に、検索文字列を検索して、検出条件と一致する箇所のフォント色やフォントスタイルの変更を行う。

正規表現検索がTrueなら、正規表現検索を行います。また、単語検索がTrueなら、関数内で、正規表現検索の文字列を作成して、正規表現検索に切り替えます。

単語検索の指定がなければ、デフォルト動作は、Falseと同様の動作となる。

正規表現検索の指定がなければ、デフォルト動作は、Falseと同様の動作となる。

文字色を変えたり、フォントスタイルを、セルと関係なく部分的に変えるには、セルの中の文字列に対して、「何文字目」から「何文字分の長さ」と指定する必要がある。そのため、検索文字列は常にセルの文字列として、検索開始位置をずらすことで、一度一致した箇所を見つけた場合にも再度、その後ろの文字列に対して再検索をかけていく作りにしています。

ポイントとして、ダブルクォーテーションで囲まれた文字列「"文字列"」の部分を正規表現での検索対象としましたが、「ElseIf Not Rng.Value = "" And Not Rng.Offset(0, 1).Value = "" Then」のようなケースのときに、「" And Not Rng.Offset(0, 1).Value = "」を検出してしまったため、「""」又は「"文字列"」を検索条件として、正規表現で表現することで回避しています。SettingシートのセルA3に記入している「(\"+\"+|\"+.*\"+)」の部分です。

正規表現検索 【検索開始位置対応】

下記の記事に載せていたマクロに対して、今回の記事用に、検索開始位置の対応を追加しました。

• 関連記事
• 文字列操作・正規表現

 
'***************************************************** 
'一致する文字列の先頭(一つ目)の文字列を返す 
'引数 pos : 検索開始位置 
'引数 text : 検索対象文字列 
'引数 format : 正規表現検索文字列 
'***************************************************** 
Function RExp_FindStr(pos As Long, Text As String, format As String) As String 
     
    Dim returnlist() As String 
    Dim getstr As String 
     
    If RExp_FindCount(Text, format, pos) > 0 Then 
 
        Call RExp_FindStrArr(Right(Text, Len(Text) - (pos - 1)), format, returnlist) 
         
        RExp_FindStr = returnlist(0) 
         
    Else 
         
        RExp_FindStr = "" 
    End If 
     
End Function 
 
' ******************************************************** 
'  一致数を調べる正規表現文字列検索 
'  第1引数 text に 第2引数 formatと一致する回数を戻り値で返す 
'  formatは、正規表現で表す。(見つからない場合0が戻る) 
'  第3引数 posをオプションで追加。検索開始位置の指定 
' ******************************************************** 
Function RExp_FindCount(ByRef Text As String, ByRef format As String, Optional pos As Long = 1) As Long 
      
    Dim RegExpObj As RegExp 
    Dim findList As MatchCollection 
    Dim findItem As Match 
    Dim cnt As Long 
      
    Set RegExpObj = CreateObject("VBScript.RegExp") 
      
    '正規表現検索の初期値設定 
    RegExpObj.IgnoreCase = True '全角半角区別 
    RegExpObj.Global = True     'すべて探す 
    RegExpObj.pattern = format  '見つけるフォーマット 
     
    Set findList = RegExpObj.Execute(Right(Text, Len(Text) - (pos - 1))) 
      
    RExp_FindCount = findList.Count 
     
    Set RegExpObj = Nothing 
     
End Function 

RExp_FindStrArr関数は、下記の記事にあります。

• 関連記事
• 文字列操作・正規表現(RExp_FindStrArr関数)

エクセルマクロ有効ブックのダウンロード

ダウンロードしたエクセルファイルを起動し、コンテンツの有効化を行う。

マクロの有効化手順については、こちら「マクロの初期設定と基本」も参考にしてください。

フォントスタイルと色の変更を行うエクセルマクロ有効ファイル(xlsm)のダウンロード