戻る  □一般操作のサロン  □ 使用方法  □ 新着記事  □ 新規に質問する!  □ トピック一覧  □ 検索  □ 過去ログ
[ 最新記事及び返信フォームをトピックトップへ ]
このトピック参照回数 :
Excelの各シートにあるカッコ内の文字を赤にしたいです

    [192226] Excelの各シートにあるカッコ内の文字を赤にしたいです-

    ■親トピック/記事引用/メール受信=OFF■

    □投稿者/ 花子 -(2020/06/19(21:44))
    □U R L/

      Excelに資料をまとめました。

      重要な単語を「」で囲んでいたのですが、やはり「」内を赤色にしたいと思います。

      量が多いのでマクロを使いたいのですが、組むことができません。

      そのため、各シートにある「」内の文字を赤にするマクロを教えていただきたいです。

      可能でしたら、「」も削除してしまって構いませんので、「」を外して、文字を赤にするマクロを組めますでしょうか?

      お手数ですが、ご教示いただけますと幸いです。

      よろしくお願いいたします。


      ++++++++++++++++++++
      OS      ⇒Windows XP
      Version⇒Excel 2007
      ++++++++++++++++++++




    [192235] Re[1]: Excelの各シートにあるカッコ内の文字を赤にしたいです-

    記事引用/メール受信=OFF■

    □投稿者/ γ -(2020/06/20(07:16))
    □U R L/
      (考え方)
      1. Findメソッド、FindNextメソッドで、"「"が含まれているセルを特定。
      2. そのセルを対象に、(複数ありうる)「と」で囲まれた文字列を
         正規表現というツールを使って、位置を調べる。
      3. 位置と長さを指定してCharactersプロパティが返すCharactersオブジェクトを使って、
         当該箇所のフォント色を変更
      
      ご参考まで。
      
      Option Explicit
      Dim re As Object
      
      '現在アクティブなブックの各シートを対象に、注目文字列のフォント色を変更
      Sub test()
          Dim ws  As Worksheet
          Dim c   As Range
          Dim firstAddress As String
      
          '正規表現の設定
          Set re = CreateObject("VBScript.RegExp")
          With re
              .Global = True
              .Pattern = "「([^」]*?)」"
          End With
      
          '各シートの「」で囲まれた文字列の色を赤に変更する
          For Each ws In Worksheets
              With ws.UsedRange
                  Set c = .Find(What:="「", LookIn:=xlValues, LookAt:=xlPart, _
                                SearchOrder:=xlByRows, SearchDirection:=xlNext)
                  If Not c Is Nothing Then
                      firstAddress = c.Address
                      Do
                          Call setColor(c) ' 対象文字列の色を赤に変更
                          Set c = .FindNext(c)
                      Loop While Not c Is Nothing And c.Address <> firstAddress
                  End If
              End With
          Next
      End Sub
      
      ' セルcを対象に、注目文字列のフォント色を赤に変更
      Function setColor(c As Range)
          Dim s       As String
          Dim m       As Object
          Dim k       As Long
          Dim startP  As Long
          Dim myLen   As Long
          
          s = c.Text
          Set m = re.Execute(s)
          For k = 0 To m.Count - 1
              startP = (m(k).FirstIndex + 1) + 1
              myLen = m(k).Length - 2
              With c.Characters(Start:=startP, Length:=myLen).Font
                  .Color = vbRed
              End With
          Next
      End Function
      
      なお、「」はそのまま残しています。
      ・元に戻す必要が生じたときに困るだろうと考えたのと、
      ・「」を削除すると、それによって後続の位置ずれが生じ、
        その対応(後ろからの処理)が必要であり、
        場合によっては既存の文字色を変更してしまう不測の事態が予想されるため
        対応していません。
      ・どうしても必要なら、そちらで工夫してください。
      
      複数のブックへの対応等の応用はそちらでやってください。 


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [192245] Re[2]: Excelの各シートにあるカッコ内の文字を赤にしたいです-

    記事引用/メール受信=OFF■

    □投稿者/ γ -(2020/06/20(14:44))
    □U R L/
      正規表現を使う必然性は無かったですね。
      普通に書くとこんなことになりますね。
      
      なお、「」には全角のほか半角もありうるので、両方に対応してみました。
      ・Findメソッドで  MatchByte:=False を追加。
      ・InStrに Compare引数を追加
      
      (なお、Option Explicit と同様に冒頭に Option Compare Text を追加すれば、
      InStrでの対応は不要になりますね。)
      
      ==== 以下、参考コード ====
      
      Option Explicit
      
      '現在アクティブなブックの各シートを対象に、注目文字列のフォント色を変更
      Sub test()
          Dim ws  As Worksheet
          Dim c   As Range
          Dim firstAddress As String
      
          '各シートの「」で囲まれた文字列の色を赤に変更する
          For Each ws In Worksheets
              With ws.UsedRange
                  Set c = .Find(What:="「", LookIn:=xlValues, LookAt:=xlPart, _
                                SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                MatchByte:=False)
                  If Not c Is Nothing Then
                      firstAddress = c.Address
                      Do
                          Call setColor2(c) ' 対象文字列の色を赤に変更
                          Set c = .FindNext(c)
                      Loop While Not c Is Nothing And c.Address <> firstAddress
                  End If
              End With
          Next
      End Sub
      
      ' セルcを対象に、注目文字列のフォント色を赤に変更
      Function setColor2(c As Range)
          Dim s As String
          Dim p1 As Long
          Dim p2 As Long
      
          s = c.Text
          p1 = InStr(1, s, "「", vbTextCompare)
          p2 = InStr(1, s, "」", vbTextCompare)
          Do
              With c.Characters(Start:=p1 + 1, Length:=p2 - p1 - 1).Font
                  .Color = vbRed
              End With
              p1 = InStr(p1 + 1, s, "「", vbTextCompare)
              p2 = InStr(p2 + 1, s, "」", vbTextCompare)
          Loop While p1 > 0
      End Function
      
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [192275] Re[3]: Excelの各シートにあるカッコ内の文字を赤にしたいです-

    記事引用/メール受信=OFF■

    □投稿者/ γ -(2020/06/23(06:44))
    □U R L/
      コロナに罹患でもされましたか?
      そうでなければ、いったん返事くらいするのが
      礼儀だと思いますよ。
      放置はダメです。



このトピック内容の全ページ数 / [0]

このトピックに書きこむ
Name/
E-Mail/

└>このツリーのレス記事をメールで受信しますか? YES/ NO/
Title/
URL/
Comment/ 通常モード->  図表モード-> (←の場合適当に改行を入れて下さい)
タグが使用できます。例 ⇒ <font color="blue">文字</font>
解決!!ありがとうございました! 解決       保留中です・・・ 保留        迷宮入りorほかあたって見ます・・ 迷宮入       すいませ〜ん。誰か〜! Help! ←※回答者専用
解決したらチェック       保留(コードテスト中など・・)         解決不可orレスが全く付かなくてほかのサイトに行くときなど・・
削除キー/
(半角8文字以内) 


- Child Forum -
Edit:ゆう-G