VBAで特定の文字以降の文字列の色の変更をしたい

質問

エクセルで特定の複数の特定の文字の色を変更したいです。

複数の文字列の色の変更の仕方については調べたのですが
変更したい文字列が複数でそれぞれ色指定が異なります。

内、ひとつは　『セル内の"→"以降の文字列』　を指定して
文字色を赤に変更したいのです。

変更したい文字列　『★とYY』を青に変えるのは下記で
できました。

(1)　『セル内の"→"以降の文字列』　を指定して文字色を赤に変更
(2)　範囲指定を開いているシート全体にする

という部分を加えたいです。

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

Sub Sumple()
Dim myReg As Object
Dim Match As Variant
Dim r As Range
Dim st As String

Set myReg = CreateObject("VBScript.Regexp")
myReg.Pattern = "★|YY"
myReg.Global = True

For Each r In Range("A1:C10") 　　　' ←範囲はActiveSheetにしたい
st = r.Value

If myReg.Test(st) Then

For Each Match In myReg.Execute(st)
r.Characters(Start:=Match.Firstindex + 1, Length:=Match.Length).Font.ColorIndex = -3394816
' フォントカラーを青
Next

End If

Next
Set myReg = Nothing
End Sub

回答No.4

tom04 · ベストアンサー

No.2です。

基本的に他人様がお考えのコードに手を加えるのは好みでないので、
新たに作ってみました。

今回も
＞UsedRange
を使っています。
ごくごくオーソドックスにやっています。

Sub Sample2()
Dim c As Range, str1 As String, str2 As String
str1 = "★"
str2 = "YY"
For Each c In ActiveSheet.UsedRange
If InStr(c, str1) > 0 Then
c.Characters(Start:=InStr(c, str1), Length:=Len(str1)).Font.ColorIndex = 5
End If
If InStr(c, str2) > 0 Then
c.Characters(Start:=InStr(c, str2), Length:=Len(str2)).Font.ColorIndex = 5
End If
If InStr(c, "→") > 0 Then
c.Characters(Start:=InStr(c, "→") + 1, Length:=Len(c)).Font.ColorIndex = 3
End If
Next c
End Sub

※　「★」や「YY」が他の文字列に置き換わっても　str1　や　str2　の部分でセットするだけで
何文字でも対応できるようにしています。
1セルに「★」や「YY」は複数回出現しないという前提です。

Sub Sample2()
Dim c As Range, str1 As String, str2 As String
str1 = "★"
str2 = "YY"
For Each c In ActiveSheet.UsedRange
If InStr(c, str1) > 0 Then
c.Characters(Start:=InStr(c, str1), Length:=Len(str1)).Font.ColorIndex = 5
End If
If InStr(c, str2) > 0 Then
c.Characters(Start:=InStr(c, str2), Length:=Len(str2)).Font.ColorIndex = 5
End If
If InStr(c, "→") > 0 Then
c.Characters(Start:=InStr(c, "→") + 1, Length:=Len(c)).Font.ColorIndex = 3
End If
Next c
End Sub

こんなんではどうでしょうか？m(_ _)m

お礼

ありがとうございます。

コードの書き方は、人それぞれで色々書き方があるのは知っているのですが・・・
拾ってきたコードを組み合わせる時に書き方が異なるものだと上手く組み合わせられなくて苦労しています。

今回、通しで書いて頂いたので、また比較して勉強することができます。

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

回答No.3

keithin

とりあえずまず「出来る」ことを目的にして、赤くするマクロと青くするマクロを２本分けて作成してください。

Sub 青くする()
Dim myReg As Object
Dim Match As Variant
Dim r As Range
Dim st As String

Set myReg = CreateObject("VBScript.Regexp")
myReg.Pattern = "★|YY"
myReg.Global = True

for each r in cells.specialcells(xlcelltypeconstants) 　　　' ←範囲はActiveSheetにしたい
st = r.Value

If myReg.Test(st) Then

For Each Match In myReg.Execute(st)
r.Characters(Start:=Match.Firstindex + 1, Length:=Match.Length).Font.color = vbblue
' フォントカラーを青
Next

End If

Next
Set myReg = Nothing
End Sub

Sub 赤くする()
Dim myReg As Object
Dim Match As Variant
Dim r As Range
Dim st As String

Set myReg = CreateObject("VBScript.Regexp")
myReg.Pattern = "★|YY"
myReg.Global = True

For Each r In ActiveSheet.UsedRange
if r <> "" then
st = r.Value

If myReg.Test(st) Then

For Each Match In myReg.Execute(st)
r.Characters(Start:=Match.Firstindex + 1, Length:=Match.Length).Font.color = vbred
' フォントカラーを赤
Next

End If

end if
Next
Set myReg = Nothing
End Sub

この２本をどうやって一本のマクロの中に仕込むかといった「応用問題」は、もうちょっとベーシックな部分をスキルアップしてからの課題にしたほうがよいと思います。

＃参考
specialcells
エクセル画面でCtrl+Gを押し、更にセル選択をクリックして現れるダイアログに従って、所定のセルを拾い上げる機能を利用します
ただし、シート上に指定条件（「セル選択」をクリックして現れるダイアログで指定した条件、をマクロで表現した条件　今回ならxlcelltypeconstants）に合致するセルが存在しないと、エラーになります。具体的には、全く何も記入していない空っぽシートで今回回答したマクロを使用しようとすると、マクロがエラーになります

usedrange
シート上で使用されているセル範囲を含む矩形の（四角い）セル範囲を取得します
ただしたとえばセルがまばらに埋まってる場合に、その全部を含む四角いセル範囲を取得してしまうので、隙間の空っぽのセルも範囲に含まれます

これらの命令の具体的な機能については、作成したマクロ上で分からない単語にカーソルを入れてＦ１キーを押し、それぞれの命令のヘルプをまず読んで何をしようとしてるのか調べることから始める習慣をぜひ身につけてください。

＃参考
今は「動くマクロ」をお膳立てして貰わないと、ご自分じゃまだほとんど先に進めない状況という事でしょうか。
でもネットなどで拾ったマクロをダメ元で動かしてみて、「動いたーダメだった―」と一喜一憂してるだけじゃ、全然進歩がありませんよね。
specialcellsとかusedrangeみたいな基本機能は、ある程度「マクロ以前にエクセルそのものの知識」が必要な部分もあります。そういうのは、エクセルやエクセルＶＢＡの「初めての」タイプの参考書等を、ある程度目を通しておくのも良いんじゃないかと思います。
また今回ネットで拾ってきたみたいな特殊機能についても、参考資料等を参考にしながら少しずつでも内容を勉強するようにしてみてください。
http://officetanaka.net/excel/vba/tips/tips38.htm

お礼

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

現状では、マクロの記録をして要らないところを削いで使う・・・という感じです。

やりたい操作の内容に応じて調べて、コードを読んで勉強する。

その繰り返しで勉強しています。

初級講座みたいなものを読んでも、イメージが湧かないので実際に動くマクロを比較しながら覚えるようにしています。

F1キーで命令のヘルプが見れるのも知りませんでした。

ありがとうございました‼︎

回答No.2

tom04

こんばんは！

＞(1)　『セル内の"→"以降の文字列』　を指定して文字色を赤に変更
考え方はお示しのコードの応用だけだと思います。
ごくごく簡単に

Sub Sample1()
Dim c As Range
For Each c In ActiveSheet.UsedRange
If InStr(c, "→") > 0 Then
c.Characters(Start:=InStr(c, "→") + 1, Length:=Len(c)).Font.ColorIndex = 3
End If
Next c
End Sub

こんなんではどうでしょうか？m(_ _)m

お礼

ありがとうございます。

回答1を下さった方にも同じことを伺ったのですが…
教えて頂いたコードのどこからどこまでを
自分が書いたコードのどこに挟めばいいのかわからないのです。

少し試したのですが、
『同じ適用範囲内で宣言が重複しています』
となってしまって…

その辺を教えて頂けると助かります！！

勉強中なので、ちょっと変わった指示を
組み込みたい時にどこに挟んだらいいのかわからないので
困っています。

お手数ですが助け舟を出して下さると助かります！！

お願いします！

回答No.1

keithin

＞範囲はActiveSheetにしたい

例えば
for each r in cells.specialcells(xlcelltypeconstants)
とかで。

＞セル内の"→"以降の文字列

myReg.Pattern = "→.*$"
とか。

お礼

ありがとうございます。
myReg.Pattern = "→.*$"
の『*$』は、ワイルドカードというヤツでしょうか。
使い方勉強になります。

ただ、これをどこに挟んだらいいのか分からないのです。
サンプルで書いたコードのどこに
＞『セル内の"→"以降の文字列』を指定して文字色を赤に変更
という情報を、挟めば良いのか分からないのでご教授頂けると助かります。

初心者なもので、ちょっと違う指示を入れる時にどこに入れればいいのかわからないのです。
初心者という事を書き忘れていました。
申し訳ありません・・・

補足

ActiveSheetの指定の仕方が
下記の様に2種類あるのですね。
上段のようにActiveSheetという言葉が入っているとわかりやすいのですが、下段の様な書き方はどういう意味なんでしょうか？
違いと意味を解説して下さる方がいらっしゃると嬉しいです。
よろしくお願いいたします。

For Each r In ActiveSheet.UsedRange
for each r in cells.specialcells(xlcelltypeconstants)