Excel マクロについて！！ 添付写真のように、各セルに文字がありますが、 (P〇〇〇)というとこ

Excel マクロについて！！





添付写真のように、各セルに文字がありますが、
(P〇〇〇)というところだけ赤色にしたいのですが、どーすれば良いでしょうか！

詳しい方よろしくお願い致します！！

No.3 ベストアンサー 回答者： WindFaller 回答日時： 2017/04/25 13:56

こんにちは。

この質問は、回答者のTさんの十八番ですが、私も考えてみました、というか、私は、考えすぎてしまいます。

>(P〇〇〇)というところだけ赤色にしたいのですが、どーすれば良いでしょうか！
以下のマクロは、(P〇〇〇)では、赤になりません。◯◯の所に数字が入っていないと赤になりません。画像をみると、そのように思えたからです。

もし違うようでしたら、"*(P#*)*" 　は、"*(P*)*" にしてください。

'//
Sub CircleRed()
　Dim c As Range
　Dim firstAddress As String
　Dim s As Long, l As Long
　With ActiveSheet.UsedRange
　　Set c = .Find("*(P*", , xlValues, xlWhole, , False, False)
　　If Not c Is Nothing Then
　　　firstAddress = c.Address
　　　Do
　　　　If StrConv(c.Value, vbNarrow + vbUpperCase) Like "*(P#*)*" Then
　　　　　s = InStr(1, c.Value, "(", vbTextCompare)
　　　　　l = InStr(1, c.Value, ")", vbTextCompare) - s + 1
　　　　　If l < 1 Then l = 2
　　　　　c.Characters(s, l).Font.ColorIndex = 3
　　　　End If
　　　　Set c = .FindNext(c)
　　　Loop While Not c Is Nothing And c.Address <> firstAddress
　　End If
　 End With
　End Sub

この回答へのお礼

ありがとうございます！！
出来ました！
もう一つお願いがあるのですが、1つのセル内に複数(P〇〇〇)がある場合にも赤色に色つけできないでしょうか？
よろしくお願い致します！！

お礼日時：2017/04/25 15:30

No.6 回答者： WindFaller 回答日時： 2017/04/26 01:37

#3の回答者です。

ほんのちょっと替えただけで済みます。
'//
Sub CircleRed2()
　Dim c As Range
　Dim firstAddress As String
　Dim s As Long, l As Long
　Dim i As Long
　With ActiveSheet.UsedRange
　　Set c = .Find("*(P*", , xlValues, xlWhole, , False, False)
　　If Not c Is Nothing Then
　　　firstAddress = c.Address
　　　Do
　　　　If StrConv(c.Value, vbNarrow + vbUpperCase) Like "*(P#*)*" Then
　　　　 i = 1
　　　　 Do　　'＊
　　　　　s = InStr(i, c.Value, "(", vbTextCompare)
　　　　　l = InStr(i, c.Value, ")", vbTextCompare) - s + 1
　　　　　'If l < i Then l = 2+i '万が一エラーが出るようでしたら、ここを外します。
　　　　　c.Characters(s, l).Font.ColorIndex = 3
　　　　　i = s + l + 1 '*
　　　　　Loop Until InStr(i, c.Value, "(", vbTextCompare) = 0 '*
　　　　End If
　　　　Set c = .FindNext(c)
　　　Loop While Not c Is Nothing And c.Address <> firstAddress
　　End If
　 End With
　End Sub

No.5 回答者： tom04 回答日時： 2017/04/25 18:56

こんばんは！

セル内で、(P　と　）は必ずセットになっているという前提です。

セル範囲が判らないので、すべてのセルを対象としています。

Sub Sample1()
Dim i As Long, k As Long, cnt As Long, c As Range
For Each c In ActiveSheet.UsedRange
For k = 1 To Len(c)
If Mid(c, k, 2) = "(P" Then
cnt = k + 1
Do Until Mid(c, cnt, 1) = ")"
cnt = cnt + 1
Loop
c.Characters(Start:=k, Length:=cnt - k + 1).Font.ColorIndex = 3
End If
Next k
Next c
End Sub

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

No.4 回答者： GooUserラック 回答日時： 2017/04/25 14:43

もしかしたら「(P〇〇〇)」を含むセル全体ではなく、セルの中の一部の「(P〇〇〇)」の文字を赤くするという事でしょうか？(１つのセ

ルで複数ある場合は複数個所の文字を赤くするという事ですよね？)

No.2 回答者： milk_kokoa 回答日時： 2017/04/25 13:23

①該当セルにカーソルを合わせてＦ２キーを押す（もしくはダブルクリック）

②該当の文字を反転（選択します）
③フォームタブのフォントにある文字の色を赤にする

No.1 回答者： ryo_ky 回答日時： 2017/04/25 12:40

画像が小さくて見えないのですが，指定の文字の位置を知るのはFIND関数ですね．

セルの色を変えるのはFont.Color
セル中の指定の位置を示すのはCharacters
これらを組み合わせればできると思いますよ．

参考
http://www.officepro.jp/excelfunc/string/index14 …
https://www.moug.net/tech/exvba/0110016.html