エクセルのfontcolorの抽出について

質問

エクセル中級、VB初心です。
宜しくお願いします。

現在、エクセルA列のセル１から１０に入っている文字列の文字の色をB列セル１から１０に結果を抽出するようなスクリプトを下記のように書いてみました。

Sub getfontcolor()
For i = 1 To 10
Cells(i, 2).Value = Cells(i, 1).Font.ColorIndex
Next
End Sub

文字列が単一の色だけであれば、何の問題もないのですが、一つのセルの中の文字列にそれぞれ異なる色がある場合に、その結果をB列以降にうまく反映させたいと考えております。

文字列の色の並びのとおりに、B列、C列、D列・・・と結果を反映させるにはどのように記載すればよいでしょうか？

文字列の長さは一定ではなく、また色の並びも規則性がなく、結構悩んでおります。
お手数ですが、よろしくお願いします。

回答No.3

temtecomai2 · ベストアンサー

とりあえず。
セルの文字が単色構成なら 1回の出力。
多色構成なら文字ごとに出力

Dim rng As Range
Dim i As Long
For i = 1 To 2
　Set rng = Cells(i, 1)
　If IsNull(rng.Font.ColorIndex) Then
　　' 多色構成
　　Dim j As Long
　　For j = 1 To Len(rng.Value)
　　　Cells(i, j + 1).Value = rng.Characters(j, 1).Font.ColorIndex
　　Next
　Else
　　' 単色構成
　　Cells(i, 2).Value = rng.Font.ColorIndex
　End If
Next

お礼

temtecomai2様
ご回答いただき、ありがとうございます。

やりたいと思っていたことがまさにこれです。
頂いたものを参考にして、夕方までには仕上げようと思います。

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

回答No.4

mu2011

一例です。

Sub sample()
Dim wk(256)
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
For j = 1 To Len(Cells(i, 1).Value)
idx = Cells(i, 1).Characters(j, 1).Font.ColorIndex
If wk(idx) <> idx Then
Cells(i, k + 2) = Cells(i, 1).Characters(j, 1).Font.ColorIndex
wk(idx) = idx
k = k + 1
End If
Next
Erase wk: k = 0
Next
End Sub

お礼

temtecomai2様
ご回答いただき、ありがとうございます。

頂いたサンプルは大体やりたいなと思っていたのと近いです。
文字列の色に対して、重複分も含みまして、それぞれに出そうと思っております。
後述いたしますが、連続して同じ色が出てきた場合の仕様は固まっておりませんです。。

回答No.2

temtecomai2

色抽出の仕様は固まっていますか？
同じ色が続いたのちに別の色が出てきた場合とか、再び同じ色が出てきた場合とか、どうするんですか？

黒黒黒黒
黒黒赤黒
黒赤黒黒
黒黒赤黒

補足

temtecomai2様
ご回答いただき、ありがとうございます。

そうなんです。
今回の件ですが、文字列内で同じ色が連続する場合もあるようで、規則性もないので、どうしたことか悩んでいます。

回答No.1

end-u

１文字ずつ見ていかなければならないというのは予測できますよね。
例えば文字列中の１文字だけ色を変える操作をマクロ記録してみてください。
すると、[Characters オブジェクト]に対して処理すれば良い、という凡その見当がつきます。

お礼

end-u様
ご回答頂き、ありがとうございます。
マクロの記録から記録されたスクリプトを参考にするのは全く考えておりませんでした。
ちょっと試してみようと思います。