【Excel VBA】セル内テキストの、フォントカラーが変更されている範囲の取得

ご助言いただければ幸いです。
現在、Excel2013にて、以下の処理を行おうとしております。

＜前提＞
A1セルに「ABC123DEF」が記載
※123のみ、文字色が青

＜処理内容＞
セル内にある文字列の、文字の色が黒以外である場合、
その文字のみを赤に変更する。

＜サンプルコード＞
Sub Test()
　For i = 1 To Len(Range("A1"))
　　If Range("A1").Characters(i, 1).Font.ColorIndex <> 0 Then
Range("A1").Characters(i, 1).Font.ColorIndex = 3
End If
Next i
End Sub

＜相談内容＞
いくつかのサイトを参照した結果、Charactersで１文字ずつチェックする方法が主流のようですが、
この方法だと、セルの文字列が長文であった場合、かなりの処理時間がかかってしまいます。

可能でれば、フォントカラーが変更されている範囲、
「ABC」「123」「DEF」をRangeなどで取得し、
その後に一括で着色処理をしたいのですが、書式変更箇所の範囲取得は可能でしょうか。
ご助言いただければ幸いです。

No.1 ベストアンサー 回答者： fujillin 回答日時： 2017/08/23 16:43

こんにちは

文字を色などの情報を保持したままオブジェクトとして取得するにはCharacters(start, length) しか方法がないと思いますので、色を順に調べたいのですから、1文字ずつテストするしかないと思います。

若干でも処理を速くできそうな可能性があるのは、ご提示の方法のように変更対象を発見したら即座に1文字ずつ色を変更するのではなく、連続している限りは走査を続け、連続が終わったところでその文字数分だけまとめて色を変更するような仕組みにすることでしょうか？
（対象の文字列にもよりますが、色を変更する処理回数が減るので、速くなる可能性はあります）

対象の文字列の状態によっても時間は変わるので一概には言えませんが、100文字のアルファベットで5か所ほどに異なる色の文字があり、全体で約40％程度の文字の色を変えるというサンプルでテストしてみました。
１行だけでは処理時間の差がわからないので、同じサンプルを100行（＝100回）処理した結果の比較をしてみました。
ご提示の方法で約5秒のところが、約3秒になりましたので多少は速くなる可能性があるものと思います。


方法としては上述の通りなので繰り返しになりますが、文字の走査は1文字ずつ順に行い、変更対象があったところから連続して変更するべき文字数を数えます。
連続が終わったところで、その文字数分をまとめて
　.Characters(start, length).Font.ColorIndex = 3
で変更するといった要領です。
加えて（どれだけ効果に寄与したかは不明ですが）、複数回同じオブジェクトを参照するのなら、一旦変数に置き換えて参照するようにするか、あるいはwith構文を利用するなどといったことでも短縮を図ってみました。

結果的には
＞可能でれば、フォントカラーが変更されている範囲、
＞「ABC」「123」「DEF」をRangeなどで取得し
に近いのかもしれませんが、1文字ずつ調べているのは変わりませんし、変更箇所をまとめて.Characters(start, length)で指定しているだけとも言えます。

この回答へのお礼

ご確認ありがとうございます。
実はまとめて着色はすでの実施しております。
どうしても一文字ずつチェック、がボトルネックになってしまうんですよね…。

時間計測までしていただき、ありがとうございました！

お礼日時：2017/08/24 13:31

No.2 回答者： WindFaller 回答日時： 2017/08/23 20:03

こんばんは。

マクロとしては作っていませんが、一旦、web フォーマット(.htm)で保存し、その中で、該当する
>123のみ、文字色が青
<font class="font76749">123</font>
>その文字のみを赤に変更する。
<font class="font66749">123</font>

と置き換えて上げればよいです。
それを保存し、もう一度、Excelで開いて、Excel用のフォーマットに保存し直せばよいです。

ただし、注意点は、Web フォーマットに保存する時に、セル幅が優先されますので、AutoFit で列幅を確保しておく必要があります。

この回答へのお礼

調査ありがとうございます。
なるほど、別形式で保存、は可能性がありそうですね。
確認してみます、ありがとうございました。

お礼日時：2017/08/24 13:32