[[20131015150502]] 『数字だけに色をつける方法』(YE) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『数字だけに色をつける方法』(YE)

Excel2010 / Windows 7 です。

文章内の数字だけ強調の為、フォントや色を変えたりしたいのですが、
うまくいきません。

条件付き書式やユーザー定義などで試してみましたが、
セル自体に設定してしまうので、同じセル内の数字以外の文字(漢字やひらがな)
もフォントや色が一緒に変わってしまいます。

数字だけその都度、フォントや色指定するのが面倒なので、
数字を認識すると自動で変換させるような方法はありますでしょうか?


小数点やマイナス符号はとりあえず無視案。

 Sub test()
    Dim R As Range
    Dim i As Long

    Range("A1").CurrentRegion.Select
    For Each R In Selection
        For i = 1 To Len(R.Text)
            If Mid(R.Text, i, 1) Like "[0-9]" Then
                R.Characters(Start:=i, Length:=1).Font.Color = -16776961
            End If
        Next i
    Next
 End Sub
(???) 2013/10/15(火) 15:36

 自動にするならvba

 シートモジュールへ

 Private Sub Worksheet_Change(ByVal Target As Range)
     Dim r As Range, m As Object
     Application.EnableEvents = False
     With CreateObject("VBScript.RegExp")
         .Global = True
         .Pattern = "\d+"
         For Each r In Target
             For Each m In .Execute(r.Value)
                 With r.Characters(m.firstindex + 1, m.Length).Font
                     .Bold = True
                     .Color = vbRed
                 End With
             Next
         Next
     End With
     Application.EnableEvents = True
 End Sub
(seiya) 2013/10/15(火) 15:46


(???)さん、(seiya)さん早速のご回答ありがとうございます!

VBAは初心者なため、できればコードの意味も教えていただけると助かります。
数字は小数点やマイナス符号など特殊なものは使用せず、整数だけの使用です。
コードをそれぞれ標準モジュールやシートモジュールにコピペしてみましたが、
今のところ変化がありません。どこか書き換えが必要なのでしょうか?
不勉強なため、何度も申し訳ありません。

(YE)


 私のコードは、シート上のどのセルでも何か入力された時点で実行されます。

 1) シートタブを右クリックして [コードの表示]を選択
 2) 出てきた画面の右空白部分にコードを貼り付けて Alt + Q

 どこかに何かを入力してみてください。
(seiya) 2013/10/15(火) 16:58


何かを入力すると色が変わるのですね!!
すごいです・・・ありがとうございます!!
思っていた通りの実行結果となりました(^▽^)
またどうしてもわからない事があればよろしくお願いいたします。
(YE)

 僭越ながら、自分なりのコード解釈を入れておきます。
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range, m As Object

    '//イベントを止めて、自身の変更でループさせなくする
    Application.EnableEvents = False

    '//RegExp(正規表現を使った文字検索)オブジェクトを作成
    '//http://msdn.microsoft.com/ja-jp/library/cc392403.aspx
    With CreateObject("VBScript.RegExp")
        .Global = True                                              '//文字列全体を検索 True=する False=しない
        .Pattern = "\d+"                                            '//正規表現で0-9の数字を1回以上繰り返す文字列を検索
        For Each r In Target                                        '//変更されたセル範囲(Target)を1セルずつループ処理
            For Each m In .Execute(r.Value)                         '//正規表現で検索されたMatchesコレクションを作成し、Item数分ループする
                With r.Characters(m.firstindex + 1, m.Length).Font  '//r(セル)の文字列中、最初に見つかった文字から、同じItemの文字数分のフォントを変更する
                    .Bold = True                                    '//Matchesコレクションは0から始まるので、+1をする
                    .Color = vbRed
                End With
            Next m
        Next r
    End With
    Application.EnableEvents = True
End Sub

(稲葉) 2013/10/15(火) 17:34


 もし数字の入ったセルを数字のない文字列で上書きしたりするなら
 下記に変更

 Private Sub Worksheet_Change(ByVal Target As Range)
     Dim r As Range, m As Object
     Application.EnableEvents = False
     With CreateObject("VBScript.RegExp")
         .Global = True
         .Pattern = "\d+"
         For Each r In Target
             r.Font.Bold = False
             r.Font.ColorIndex = xlAutomatic
             For Each m In .Execute(r.Value)
                 With r.Characters(m.firstindex + 1, m.Length).Font
                     .Bold = True
                     .Color = vbRed
                 End With
             Next
         Next
     End With
     Application.EnableEvents = True
 End Sub
(seiya) 2013/10/15(火) 17:35

私の案の方は、シートモジュールに貼った後、マクロ実行すると動作します。
ActiveXのボタンを貼っておき、これのコードにしてしまうと使いやすくなります。
(???) 2013/10/15(火) 17:48

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.