カラー番号でカウントするには

質問

いつもお世話になります。
WIN7 EXCELL2010　です。

下記のマクロと数式にて　F4:F7　にカラー番号を示しています。
マクロ
Function CellColor(セル)
CellColor = セル.Interior.ColorIndex
End Function
数式
F4 =CellColor(E4)

御指導を仰ぎたいのは、
F4 : F7 の４つのみのカラー番号(この場合　24/14/40/48)で
B2 には　5件
C2　には 2件　と関数でカウントすることは可能でしょうか。
もし可能ならばご教授をいただけないでしょうか。
よろしくお願いします。

回答No.6

tom04 · ベストアンサー

No.3・4です。

＞追加してゆく分には大成功ですが何かの拍子にミスして、
＞塗りつぶしを塗りつぶしなしにするとカウントが減りません。

の件ですが「ユーザー定義関数」のヘルプとして
＞色などの書式を使って計算するときには、大きな注意点が一つあります。それは、書式を変更しても自動再計算されないということです。セルの値を変更すれば自動的に再計算されますが、セルの色を変えても再計算はされないのです

という一文があります。
今回の場合、
なぜ色を付ける場合に反応して、「色なし」にした場合に反応しない！と理由は判りませんが・・・
対処方法として
（1）強制的に　F9キーを押下して再計算する
（2）操作したいSheet見出し上で右クリック　→　コードの表示　→　VBE画面に

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveSheet.Calculate
End Sub

といった感じのコードを入れておいて、別のセルを選択して再計算を実行するか！
といった方法しか思いつきません。

※　Changeイベント　では書式の変化は「Change」と認識してくれませんので反応しないと思います。
他に良い方法があればごめんなさいね。m(_ _)m

お礼

いつもいつもご指導を頂きありがとうございます。
色のついたセルには苦労しました。
今後ともよろしくお願いします。

回答No.8

kkkkkm

No7の追加です

Ctrl+Alt+F9以外でもCtrl+Zで操作を元に戻す(ツールバーの元に戻すでも同じです)とカウンターも戻ります。こちらの方が片手で済みますね。

お礼

最後までご親切にご指導いただきありがとうございました。
感謝します。

Ctrl+Alt+F9以外でもCtrl+ZでしたがテストではCtrl+Alt+F9の方が早く反応してくれます。
私のPCとの相性でしょうですかね。

回答No.7

kkkkkm

> 追加してゆく分には大成功ですが何かの拍子にミスして、
> 塗りつぶしを塗りつぶしなしにするとカウントが減りません。

その場合、Ctrl+Alt+F9を押してください。

あと、書き忘れましたが、前回の補足で「E4 を　コピーして　B4 に張り付けている」と書かれていたので、私の場合、E4 : E7 の4つのみのカラー以外で塗りつぶされるセルは無い、もしくはE列のセルのコピーしかしていないために、カウントするセルにはE列で指定された色しか存在しないという考えで、塗りつぶされたセルを単純に数えるという手抜きなコードにしています。それ以外の色で塗りつぶされる可能性があるのでしたら正常にカウントしませんのでよろしくお願いします。

回答No.5

kkkkkm

> E4 を　コピーして　B4 に張り付けているだけなので特にこれと言った条件はないのです

適当にという事でしょうか。とりあえず、条件がないとすれば自作関数ですね。以下のようなやり方でいかがですか。ただし、条件式書式で色が設定されたセルはカウントされません。条件がないという事なのでそれは無視できると思います。

Function CountColor(MyRange As Range)
Dim c As Range
Dim i As Integer

For Each c In MyRange
If c.Interior.ColorIndex <> xlNone Then
i = i + 1
End If
CountColor = i
Next
End Function

式
B2= CountColor(B3:B10)
B10は調べたい範囲まで指定してください。

補足

早速の御指導を感謝しています。
試させていただきました。

追加してゆく分には大成功ですが何かの拍子にミスして、
塗りつぶしを塗りつぶしなしにするとカウントが減りません。

これは何とかならないもんでしょうか。
可能ならば再度ご指導いただけませんか。

是非ご協力ください。
宜しくお願いいたします。

回答No.4

tom04

No.3です。

たびたびごめんなさい。
前回のコードで不要な行がありました。

＞Set r = 検索
＞Set c = 範囲

の2行は不要ですので、削除してください。m(_ _)m

補足

tom04さん
こんにちは
いつもありがとうございます。
早速の御指導を感謝しています。
試させていただきました。

追加してゆく分には大成功ですが何かの拍子にミスして、
塗りつぶしを塗りつぶしなしにするとカウントが減りません。

これは何とかならないもんでしょうか。
可能ならば再度ご指導いただけませんか。

是非ご協力ください。
宜しくお願いいたします。

回答No.3

tom04

こんにちは！
ユーザー定義関数を使いたい！というコトですので、
標準モジュールに

Function 色数(範囲 As Range, 検索 As Range)
Dim c As Range, r As Range, cnt As Long
Set r = 検索
Set c = 範囲
For Each c In 範囲
For Each r In 検索
If c.Interior.ColorIndex = r Then
cnt = cnt + 1
End If
Next r
Next c
色数 = cnt
End Function

として、結果を表示したいセルを選択　→「fx」をクリック　→　ユーザー定義関数から　「色数」を選択
後は　「関数の挿入引数」の
「範囲」の窓に色をカウントしたい範囲を選択　→　「検索」の窓に　画像では　F4:F7　セルを絶対参照として　→　OK
とりあえず画像の範囲では数式バーには
=色数(B4:B9,$F4:$F7)
と表示されるはずですので、これをフィルハンドルで右へコピーしてみてください。

※　今回は「カラーインデックス」で判定していますが、お示しの配置でセル色で判断したい場合は
＞If c.Interior.ColorIndex = r Then
の行を
＞If c.Interior.Color = r.Interior.Color Then
として、「検索」範囲はセルの色がついている $E4:$E7 とします。m(_ _)m

回答No.2

kkkkkm

関数でセルの色の有無を判別することはできませんので、自作関数を作成するか、色を付ける条件を条件とするCOUNTIFS関数をご利用ください。

補足

E4 を　コピーして　B4 に張り付けているだけなので特にこれと言った条件はないのです。

回答No.1

watabe007

>B2 には　5件
B列でF4:F7に示された色の着いたセルの数なら
Function ColorCount(セル)
　　Dim myRng As Range, i As Long, j As Long, n As Long

　　Set myRng = ActiveSheet.UsedRange.Columns(セル.Column)
　　For i = 1 To myRng.Cells.Count
　　　　n = myRng.Cells(i).Interior.ColorIndex
　　　　If Not IsError(Application.Match(n, Range("F4:F7"), 0)) Then
　　　　　　j = j + 1
　　　　End If
　　Next
　　Set myRng = Nothing
　　ColorCount = j
End Function

数式
B2 = ColorCount(B1)

補足

早速の御指導ありがとうございます。
御指導のマクロを
1　シートの表示　コードの表示
2　THIS SHEET
いずれにも
B2 = ColorCount(B1)

試しましたが　B2 には「#NAME?」と表示されます。

再度ご指導いただけませんか。