エクセルでの文字色を数える関数に関して。。。

質問

エクセルのセル内の文字色に関してのマクロを下記の通り書きました。

Function SpecialCell(targetRange As Range, _
intColor As Integer) As Integer
'赤は3，緑は4，青は5，黄は6
Dim myCell As Range

For Each myCell In targetRange
If myCell.Font.ColorIndex = intColor _
Or myCell.Interior.ColorIndex = intColor Then
SpecialCell = SpecialCell + 1
End If
Next
End Function

その後答えを求めるセルに
=SpecialCell(D5:D125,3)

これはちゃんと表示できます。

しかし、
=SpecialCell(D10,D8,D29,D49,D51,D57,3)

このようにセルの個別ごとに求めようとすると
#VALUE!

が出ますので引数が間違っているのだとは思うのですが、
この場合はどうすればよろしいでしょうか？

また、セル内に複数の色つき文字がある場合、
例えば同一セル内に
(1)(2)(3)
とあって、
(1)が赤
(2)が青
(3)がピンク

とした場合、
=SpecialCell(D5:D125,3)
これでは０と出てきてしまいます。。。
この場合はどういう風に数式をいれればよいのでしょうか？

以上2点ほどご教授いただけると助かります。
よろしくお願いいたします。。。

回答No.11

Cor_moriyan · ベストアンサー

kmetu さんの「セル範囲を（）で囲む」を私のソースに適用させてもらって(^^;
ん？ (1) は【丸囲み数字１】ですか？では

Function SpecialCell(TargetRange As Range, intColor As Integer) As Integer
　　'赤は3，緑は4，青は5，黄は6
　　Dim myCell　　　As Range
　　Dim intIDX　　　As Integer
　　Dim strVALUE　　As String

　　For Each myCell In TargetRange
　　　　If myCell.Font.ColorIndex = intColor Then
　　　　　　SpecialCell = SpecialCell + 1
　　　　　　GoTo SkipFor
　　　　End If
　　　　If myCell.Interior.ColorIndex = intColor Then
　　　　　　SpecialCell = SpecialCell + 1
　　　　　　GoTo SkipFor
　　　　End If
　　　　If myCell.Value <> "" Then
　　　　　　For intIDX = 1 To Len(myCell.Value)
　　　　　　　　If myCell.Characters(intIDX, 1).Font.ColorIndex = intColor Then
　　　　　　　　　　SpecialCell = SpecialCell + 1
　　　　　　　　End If
　　　　　　Next
　　　　End If

SkipFor:
　　Next

End Function

これで、=SpecialCell((D10,D8,D29,D49,D51,D57),3)　のように書けばＯＫかと。

お礼

たびたびありがとうございます。

このコードを試したところ、無事D欄・E欄ともに計算してくれました。

そして恐縮ながらもう一つ教えていただけると助かります。。。

Dの縦欄は、セル内背景色を分けているのと、文字色は1色です。
（なので、背景色ごとのセル分けで集計するための問１でした）

このセル内の背景色を4色で分けているのですが、中の文字色は関係なく、背景色の数字を数えるのはできますでしょうか？

%を出す為に、現在背景色を手計算で問１で教えていただいた数字で割っております。。。
この背景色も計算できると非常に助かります。。。
（現在のD欄とE欄の計算式が壊れないよう）

http://miyahorinn.fc2web.com/tips/s_02_02_04_02.html
とりあえず、これを元に作成してみますけど、問題があればご教授下さいませ。
よろしくお願いたします。。。

そしてありがとうございました。。。
助かりました。。。

補足

ごめんなさい。下記のURLでいけました。

今までの経緯を思うと、壊れるの前提で書いてしまいましたｗ

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

回答No.1

kybo

コードは以下のようにして、

Function SpecialCell(intColor As Integer, ParamArray targetRange() As Variant) As Integer
'赤は3，緑は4，青は5，黄は6
Dim myCell As Range, I As Integer
For I = 0 To UBound(targetRange)
For Each myCell In targetRange(I)
If myCell.Font.ColorIndex = intColor _
Or myCell.Interior.ColorIndex = intColor Then
SpecialCell = SpecialCell + 1
End If
Next
Next
End Function

セルには、

=SpecialCell(3,D10,D8,D29,D49,D51,D57)

のように入力してみください。

お礼

回答ありがとうございます。

問い１の方はとりあえず簡単そうなNO2さんの方法でうまくいきました。

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

問い２の方で未だ苦戦中です。
よろしければまたご教授くださいませ。。。