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

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

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

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

こんばんは！

＞(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

＞範囲はActiveSheetにしたい

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



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

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