[[20050616120721]] 『文字列の中の特定の文字だけ色を変えたい』(総務娘) ページの最後に飛ぶ

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

 

『文字列の中の特定の文字だけ色を変えたい』(総務娘)

 お世話になっております<(_ _)>
 例えば「テキスト」という文字列の「テ」だけを赤にする、ということはできますか?
 置換では「テキスト」全体が赤になってしまいました。
 よろしくお願いします。エクセルは2003です。

 こんにちは
 地道に、テだけを選んで赤色にするのではダメなのでしょうか?(Aster)

 Asterさん、ご回答ありがとうございます。
 なにしろ、量がすごいもので(しかも、シート中にその文字があるのです)
 できれば一括で変更したいのです。
 よろしくお願いします。

 どれくらいの確度でできるかわからないが、Wordの機能を利用。
一箇所ずつ編集するよりは早いはず。
Office2002で200セルくらいの置換を検証した。
 
変換したい範囲をコピー、Word新規文書へ貼り付け。
Wordで目的のテキストの書式置換。
置換後のWordのテキストをExcelへ貼り付けなおす。
(みやほりん)


 マクロで考えてみました

 Sub TEST()

    MyData = "テキスト"  '検索文字
    IroData = "テ"       '色付け文字

    Sa = InStr(1, MyData, IroData)
    For Each Cel In Selection
        Poji = InStr(1, Cel.Value, MyData)
        If Poji > 0 Then
            Cel.Characters(Poji + Sa - 1, Len(IroData)).Font.ColorIndex = 3
        End If
    Next
 End Sub
 (BB)

 みやほりんさん
 ご回答ありがとうございます!
 なるほど・・・そんなテもありましたか!
 エクセルを追求していらっしゃるからこそのあわせ技、目からうろこでした。
 試しにやってみましたが、うまくいきました(^O^)
 ありがとうございます。
 面倒がらず、いろいろなところに目を向けるべきですね。新たな発見でした。
 本当にありがとうございました<(_ _)>

 BBさん
 ご回答ありがとうございます!
 す、素晴らしいです、一発でした。
 マクロは、全然わからないのですが望んでいることがスパッと出来ました(*^_^*)
 とても助かりました!!

 ちなみにSUBSTITUTE関数できるかな?と思ったのですが色の指定方法がわかりません。
 もしかしたらできないのかもしれないんですが、もし方法をご存知の方いらっしゃいましたら、今後の勉強のため引き続き回答お願いします<(_ _)>
 私の考えたところでは
 SUBSTITUTE(範囲,"検索文字列","置換文字列")
 【例】A2の「テキスト」の「テ」を赤にする
 SUBSTITUTE(A2,"テ","テ"←ここに色の指定が出来たら・・・)
 (総務娘)

 すみません<(_ _)>訂正です・・・
 BBさんに作っていただいたマクロは、テスト用のシートでしかできませんでした。
 すみません、「テキスト」というのは例えでして、実は
 「テキスト」「テープ」「カルテ」「テニス」などシート内のいろんな文字列中から
 「テ」に色をつけたいのです。
 そうなると、最初の
 MyData = "テキスト"  '検索文字
 ここに、全部のセルの文字列をいれないといけなくなりますか?
 それとも、作っていただいたマクロでは不可能でしょうか?
 説明不足でお手数をお掛けいたしまして申し訳ありませんが、よろしくお願いします。
 (総務娘)

 質問です。
 特定の文字列中のテだけの色を変えたいのではなくて、
 すべてのテの色を変えたいということですか?

 とりあえず、特定の文字列複数バージョン
 Sub TEST2()
    Dim MyBoom() As String
    MyDatas = "テキスト テープ カルテ テニス" 'ここに特定文字列をかいて下さい。
                        '文字列と文字列の間は、半角スペースです
    MyBoom() = Split(MyDatas)
    IroData = "テ"
    For Each Cel In Selection
        For i = 0 To UBound(MyBoom)
            MyData = MyBoom(i)
            Sa = InStr(1, MyData, IroData)
            Poji = InStr(1, Cel.Value, MyData)
            If Poji > 0 Then
                Cel.Characters(Poji + Sa - 1, Len(IroData)).Font.ColorIndex = 3
            End If
        Next
    Next
 End Sub
 (BB)

 BBさん、たびたびありがとうございます!
 そうです、すべての「テ」の色を変えたいです!
 最初からそう言えばよかったのですね、すみません、うまく言えなくて・・・m(_ _;m)
 何度も恐れ入りますが、よろしくお願いします〜〜〜〜
 (総務娘)

 お邪魔します。ちょっと遅いけど。。
Option Explicit
Sub てすと()
Dim MyAreas As Areas
Dim MyArea As Range
Dim MyAry() As Variant
Dim z() As Variant
Dim MyCel As Range
Const MyStr As String = "テ"
Dim i As Long, j As Long
Dim n As Long, k As Long
With ActiveSheet
    On Error Resume Next
    Set MyAreas = .UsedRange.SpecialCells(xlCellTypeConstants).Areas
    On Error GoTo 0
End With
If MyAreas Is Nothing Then Exit Sub
For Each MyArea In MyAreas
    With MyArea
        If .Count = 1 Then
            ReDim MyAry(1 To 1, 1 To 1)
            MyAry(1, 1) = .Value
        Else
            MyAry = .Value
        End If
        .Font.ColorIndex = 0
        For i = 1 To UBound(MyAry, 1)
            For j = 1 To UBound(MyAry, 2)
            Set MyCel = .Item(i, j)
                For n = 1 To Len(MyAry(i, j))
                    If Mid(MyAry(i, j), n, 1) = MyStr Then
                        ReDim Preserve z(k)
                        z(k) = n
                        k = k + 1
                    End If
                Next
                If k > 0 Then
                    For n = LBound(z) To UBound(z)
                        MyCel.Characters(z(n), 1).Font.ColorIndex = 3
                    Next
                    ReDim z(0 To 0)
                    k = 0
                End If
            Next
        Next
    End With
Next
Erase MyAry, z
Set MyCel = Nothing
Set MyAreas = Nothing
End Sub
(SoulMan)

 すでに(SoulMan)さんが配列の高速バージョンを作成して
 くれてますね。
 一応すべてのテの色を変える分も載せておきます。

 Sub TEST3()
    IroData = "テ"
    For Each Cel In Selection
        poji = InStr(1, Cel.Value, IroData)
        Do Until poji = 0
            If poji > 0 Then
                Cel.Characters(poji, Len(IroData)).Font.ColorIndex = 3
                poji = InStr(poji + 1, Cel.Value, IroData)
            End If
        Loop
    Next
 End Sub
 (BB)

 SoulManさん、ご回答ありがとうございます。
 BBさん、何度も本当に感謝です(TдT)
 お礼が遅くなってしまって、申し訳ありません。
 おかげさまで無事、見事に処理できるようになりました!
 こんなことができるなんて、本当に便利ですね。私も精進したいと思います!!!!
 また何かございましたら、よろしくお願いいたします<(_ _)>
 (総務娘)


コメント返信:

[ 一覧(最新更新順) ]


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