ここから本文です

エクセルのマクロで Dim rng As Range, cl As Range, i As Long, txt As String ...

zer********さん

2017/5/1117:41:40

エクセルのマクロで
Dim rng As Range, cl As Range, i As Long, txt As String
With ActiveSheet

Set rng = .Range("l12:l500") '範囲の設定
txt = "failed"
'------
For Each cl In rng
s = 1
While s <= Len(cl)
p = InStr(s, cl, txt, 1)
If p > 0 Then
cl.Characters(p, Len(txt)) _
.Font.Color = vbRed
s = s + p
Else
GoTo p1
End If
Wend
p1:
Next
End With
というものを実行したら画像のような結果になりました。
色の変わっていない部分は何故色が変わらないのでしょうか?
またその解決方法はありますか?
ぜひ教えてください

failed&amp;quot,cl.Characters,txt As String,GoTo p1,cl As Range,Dim r As Range,Dim s As String

この質問は、活躍中のチエリアン・専門家に回答をリクエストしました。

閲覧数:
277
回答数:
3

違反報告

ベストアンサーに選ばれた回答

msk********さん

2017/5/1122:55:56

次検索位置の調整がおかしい、検索位置に検索文字列長を加算する様にしましょう。
s = s + p

s = p + Len(txt)

一例ですが、正規表現を利用するともっと簡素になります。
Sub sample()
Dim r As Range, m, i As Long
With CreateObject("VBScript.RegExp")
.Pattern = "failed"
.Global = True
For Each r In Range("L12:L500")
For Each m In .Execute(r)
r.Characters(m.FirstIndex + 1, m.Length).Font.Color = vbRed
Next
Next
End With
End Sub

質問した人からのコメント

2017/5/12 09:28:46

ありがとうございました
きちんと動作しました

ベストアンサー以外の回答

1〜2件/2件中

並び替え:回答日時の
新しい順
|古い順

プロフィール画像

カテゴリマスター

lin********さん

リクエストマッチ

2017/5/1209:07:53

もっと、単純に考えられたらいいのではないでしょうか?

というのは、「s = 1」で、「While s <= Len(cl)」とするのではなく、単純に「p = 0」まで繰り返すのです。

Sub Sample()
Dim cl, rng As Range
Dim txt As String
Dim s, p As Long
Set rng = Range("L12:L500")
txt = "failed"
For Each cl In rng
s = 1
Do
p = InStr(s, cl, txt, 1)
If p > 0 Then
cl.Characters(p, Len(txt)).Font.Color = vbRed
s = s + Len(txt)
End If
Loop Until p = 0
Next cl
End Sub

これで、試した結果、ちゃんとすべての「failed」が赤文字になり、それ以外の文字は、黒文字のままでした。

なお、最後に、質問者は「Range()」を書くとき、アルファベットは必ず大文字で書く習慣を付けてください。

大変見にくいです。

今回は、特に「L」ということで、ホント、見にくかったです。

「動けばいい」のはいいのですが、その中でできる限り、美しいプログラミングにも心がけてください。

kik********さん

2017/5/1118:28:19

> 色の変わっていない部分は何故色が変わらないのでしょうか?

これは、次の検索開始位置を求める方法が・・・・

>> s = s + p

2 ~ 3 回ループしてみれば、
s がおかしな位置を指すことがわかると思います

5文字の文字列が繰り返し出現しているとします
各5文字の先頭は、1, 6, 11, 16 ・・・・

s = 1

p = 1
s = 1 + 1 = 2

p = 6
s = 2 + 6 = 8

p = 11
s = 8 + 11 = 19
・・・

雰囲気以下では?

Dim r As Range
Dim s As String
Dim i As Long, k As Long
Const CTXT As String = "failed"

k = Len(CTXT)
With ActiveSheet
   For Each r In .Range("l12:l500")
      With r
         .Font.ColorIndex = xlAutomatic
         s = .Value
         i = 1 - k
         Do While (1)
            i = InStr(i + k, s, CTXT)
            If (i = 0) Then Exit Do
            .Characters(i, k).Font.Color = vbRed
         Loop
      End With
   Next
End With

あわせて知りたい

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる