「ブロック機能」のリニューアルについて

マクロ実行で以下のように一括色変更できないでしょうか?
1文字での変更は下記コードでおこなうことができましたが、複数であると初心者でとても分かりません。
※S25とF30.、F5.は加工進行でいろいろ数値のみ変えます。
※M100、M101は全体の4文字は変わりませんが数字は増えていき、ランダムにこの先の加工進行上でてきます。
※M03、M00は3文字で変わりません。

現在以下のコードで1文字ずつならできます。


Sub test01()
Dim cl As Range
For Each cl In Range("a1:a10")
r = InStr(cl, "M00")
If r <> 0 Then
cl.Characters(r, 3).Font.ColorIndex = 3
End If
Next
End Sub

「EXCEL VBA で複数の特定文字に色」の質問画像
教えて!goo グレード

A 回答 (5件)

No.2・3・4です!


親の仇のように顔をだします。

No.4のお礼欄に
>D列、E列、F列、G列まで色を配置して
とありましたので・・・
列で色を決めるのではなく、前回のC列データのフォントを好みの色にしておいて
その文字はその色に表示する!という考え方でのコードにしてみました。
※ 今回は複数回出現してもC列にあるデータはすべてをC列データ色にするようにしています。

Sub Sample2()
Dim i As Long, k As Long, n As Long, str As String
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
For k = 1 To Cells(Rows.Count, "C").End(xlUp).Row
For n = 1 To Len(Cells(i, "A"))
str = Cells(k, "C")
If Mid(Cells(i, "A"), n, Len(str)) = str Then
Cells(i, "A").Characters(Start:=n, Length:=Len(str)).Font.Color = Cells(k, "C").Font.Color
End If
Next n
Next k
Next i
End Su

こんなんではどうでしょうか?m(_ _)m
    • good
    • 0
この回答へのお礼

本当にありがとうございました。
さっそく吟味したいと思います。
また質問のときは、親の仇のように現れてください。

お礼日時:2013/07/19 20:36

No.2・3です!


たびたびごめんなさい。

前回の方法はA列セルにC列データが1回しか出現しない!という前提ですので、
複数回出現し、すべてに色を付けたい場合は
A列の文字を舐めるように検索していく必要があると思います。

※ 余計なお世話かもしれませんが、投稿後に気になったもので・・・

どうも失礼しました。m(_ _)m
    • good
    • 0
この回答へのお礼

丁寧な解答ありがとうございます。
このコードも大変役に立つと感じました。
さらにD列、E列、F列、G列まで色を配置して列による
文字の色管理ができれば完璧です。
初心者ですので前回のコードも含めて最後までのコードが
知りたいです。

お礼日時:2013/07/19 17:44

No.2です!


画像をアップするのを忘れていました。

何度もごめんなさい。m(_ _)m
「EXCEL VBA で複数の特定文字に色」の回答画像3
    • good
    • 0

こんにちは!


一例です。

↓の画像のように別列(今回はC列)に色をつけたいデータを入力しておきます(空白セルがないように!)

データはA列の1行目からあるとします。

Sub Sample1()
Dim i As Long, k As Long
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
For k = 1 To Cells(Rows.Count, "C").End(xlUp).Row
If InStr(Cells(i, "A"), Cells(k, "C")) > 0 Then
Cells(i, "A").Characters(Start:=InStr(Cells(i, "A"), Cells(k, "C")), Length:=Len(Cells(k, "C"))). _
Font.ColorIndex = 3
End If
Next k
Next i
End Sub

こんな感じではどうでしょうか?m(_ _)m
    • good
    • 0

S25とF30.とF5.において、数字部分の桁数が変化しないのでしたら、



Sub test01()
Dim cl As Range

For Each cl In Range("a1:a10")

r = InStr(cl, "M00")
If r <> 0 Then
cl.Characters(r, 3).Font.ColorIndex = 3
End If

r = InStr(cl, "M03")
If r <> 0 Then
cl.Characters(r, 3).Font.ColorIndex = 4
End If

r = InStr(cl, "M")
If r <> 0 And (cl Like "*M[0-9][0-9][0-9]*") Then
cl.Characters(r, 4).Font.ColorIndex = 5
End If

r = InStr(cl, "S")
If r <> 0 And (cl Like "*S[0-9][0-9]*") Then
cl.Characters(r, 3).Font.ColorIndex = 6
End If

r = InStr(cl, "F")
If r <> 0 And (cl Like "*F[0-9][0-9].*") Then
cl.Characters(r, 4).Font.ColorIndex = 7
End If

r = InStr(cl, "F")
If r <> 0 And (cl Like "*F[0-9].*") Then
cl.Characters(r, 3).Font.ColorIndex = 9
End If

Next
End Sub


という感じでどうでしょうか。
    • good
    • 0
この回答へのお礼

早速やってみまして出来ました。!!こんなにうまくいくなんて!MSZ006 さん ありがとうございました。今まで一つ一つ目で追ってやっていたが時間の無駄に感じています。

お礼日時:2013/07/19 17:12

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

教えて!goo グレード

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング