| |
>▼ひゅーが さん：
>こんばんは。
>>すでにシートに入力されたデータの中で、特定の文字列(複数)の色を変更したいのですが、
>>どなたかよい方法をご存じないでしょうか。
>>いろいろ試してみたんですが、なかなかうまくいかず困っています。
>>みなさんのお知恵を貸していただけるとさいわいです。
>>よろしくお願いします。
>以下の例は、保護などされていないアクティブシートに対しての例です
>'========================================================
>Sub main()
> Dim rng As Range
> Dim 開始 As Range
> Dim 色かえる文字列 As String
> 色かえる文字列 = "abc" '例では、abcという文字列の色を変更します
> Set 開始 = Cells.SpecialCells(xlCellTypeLastCell)
> Set rng = find_rng(開始, Cells, 色かえる文字列)
> Do While Not rng Is Nothing '指定文字列が含まれるセルがある間ループ
>
> Call chg_char_color(rng, 色かえる文字列, 4, True)
> ' ↑色を変える処理
> Set rng = find_rng(開始)
> ' 次の検索
> Loop
>End Sub
>'====================================================================
>Function find_rng(開始 As Range, Optional 検索範囲 As Range = Nothing, Optional fwd = "") As Range
>'input 検索範囲: 省略可能 検索するセル範囲
>' fwd : 省略可能 検索する文字､数値
>'input-output 開始 : 検索開始セルを指定する最初は､最後のセルを指定する
>' 2回目以降は、ｻﾌﾞﾙｰﾁﾝがi/oに使用する
>'output find_rng :検索した結果条件にあったセル。尚､見つからない場合､もしくは、一通り､検索が終了した場合は､nothingが入る
> Static sv検索範囲 As Range
> Static svfwd
> Static first_fd As Range
> Dim fd As Range
> If Not 検索範囲 Is Nothing Then
> Set sv検索範囲 = 検索範囲
> svfwd = fwd
> Set first_fd = Nothing
> End If
> With sv検索範囲
> If first_fd Is Nothing Then
> Set fd = .Find(svfwd, 開始, LookIn:=xlValues, MatchCase:=True, MatchByte:=True)
> Set first_fd = fd
> Set 開始 = fd
> Set find_rng = fd
> Else
> Set fd = .FindNext(開始)
> If Not Intersect(first_fd, fd) Is Nothing Then
> Set find_rng = Nothing
> Else
> Set 開始 = fd
> Set find_rng = fd
> End If
> End If
> End With
>End Function
>'=====================================================================
>Function chg_char_color(rng As Range, col_str As String, color_idx As Long, Optional whole As Boolean = False) As Long
>'指定されたセルの指定された文字列を指定されたカラーインデックスの色に変える
>'input rng : 文字列の入ったセル
>' col_str:色を変更する文字列
>' color_idx :カラーインデックス
>' whole: true 複数個の文字列の色変更,false 最初だけ変更（規定値)
> Dim st As Long
> Dim c_len As Long
> st = 1
> c_len = Len(col_str)
Do While st <= Len(rng.Value)
> st = InStr(st, rng.Value, col_str)
> If st > 0 Then
> With rng.Characters(Start:=st, Length:=c_len).Font
> .ColorIndex = color_idx
> End With
> st = st + c_len
> If whole = False Then Exit Do
> Else
> Exit Do
> End If
> Loop
>End Function
>
>確認してみて下さい。
|
|
ichinose
- 03/12/17(水) 21:14 -
