[[20171214131731]] 『文字の一部一致で色を変える』(torao) ページの最後に飛ぶ

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

 

『文字の一部一致で色を変える』(torao)

いつもお世話になっております。

[[20121208131951]]

上記の記事の中に(seiya)さんの「共通する3文字以上の文字列を赤くする」マクロのコードがありますが、これを最初の文字だけにするにはどこを直せば良いのか、教えていただけないでしょうか。

< 使用 Excel:Excel2013、使用 OS:Windows7 >


         Loop
         .Pattern = Join$(a, "|")   <-  これ
         For Each r In rng 

         Loop
         .Pattern = "^(" & Join$(a, "|") & ")"  '<- これに変更
         For Each r In rng

 ということですか?
(seiya) 2017/12/14(木) 14:45

(seiya)様
早速ありがとうございます。

もう一つお聞きしたいのですが、今現在シートが3枚ほどありますが、
ファイル全体の検索は無理でしょうか。
(torao) 2017/12/14(木) 15:17


 只今外出先です。
 ファイル全体と言うのは、シートごとの共通ですか
 それとも全シートで共通ですか?
( seiya) 2017/12/14(木) 15:46

全シート共通です。

C列に工事名があったとして、○○○新築工事などと書いてあります。
○○○はたいてい現場や受注先の名前が入ったりするので、最初の3文字で検索したいのです。

1シートに50行ほど書いてありますが、Sheet1と2で同じような工事名が書かれていても気付かない場合があるので、伺いました。

よろしくお願いいたします。
(torao) 2017/12/14(木) 16:44


 これで試してください。

 Sub test()
     Dim ws As Worksheet, rng As Range, r As Range, a() As String, txt, i As Long, m As Object
     For Each ws In Worksheets
         Set rng = ws.Range("c1", ws.Range("c" & Rows.Count).End(xlUp))
         rng.Font.ColorIndex = xlAutomatic
         txt = Trim(txt & " " & Join(ws.Evaluate("transpose(if(" & rng.Address & "<>""""," & rng.Address & "))")))
     Next
     For Each ws In Worksheets
         With CreateObject("VBScript.RegExp")
             .Global = True
             .Pattern = "(\S{3,}).*(\1)"
             Do While .test(txt)
                 i = i + 1
                 ReDim Preserve a(1 To i)
                 a(i) = .Execute(txt)(0).submatches(1)
                 txt = Replace(txt, a(i), "")
             Loop
             .Pattern = "^(" & Join$(a, "|") & ")"
             For Each r In ws.Range("c1", ws.Range("c" & Rows.Count).End(xlUp))
                 For Each m In .Execute(r.Value)
                     r.Characters(m.firstindex + 1, m.Length).Font.Color = vbRed
                 Next
             Next
         End With
     Next
 End Sub
(seiya) 2017/12/14(木) 17:40

seiya様

先日はそのまま退社してしまい、失礼致しました。

さっそく上記のマクロを実行いたしましたが、【実行時エラー13 型が一致しません】となり、デバックを押してみたところ、以下の箇所が黄色くなっておりました。

txt = Trim(txt & " " & Join(ws.Evaluate("transpose(if(" & rng.Address & "<>""""," & rng.Address & "))")))

申し訳ありません。
今一度よろしくお願いいたします。
(torao) 2017/12/15(金) 10:23


申し訳ありません。

【実行時エラー424 オブジェクトが必要です】でした。
エラーの箇所はおなじです。

失礼致しました。
(torao) 2017/12/15(金) 10:27


 C列が空白のシートはありませんか?
(seiya) 2017/12/15(金) 10:43

seiya様

さっそくの返信ありがとうございます。
コピーして使用していたファイルのため、Sheet3が未入力でした。
適当な文字を数行入れてみたところ、文字の色が変わりました。
助かります!!

本当にありがとうございました。

(torao) 2017/12/15(金) 11:49


コメント返信:

[ 一覧(最新更新順) ]


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