指定日より指定日の塗りつぶしの合計

エクセル2002にてカレンダーを作りました。
（例）　　　　　　　２００８年１月
　　｜　　C　　D　　E　　F　　G　　H　　I
　８｜　月　　火　　水　　木　　金　　土　　日
　９｜　　　　　１　　２　　３　　　４　　５　　　６　　　　　
１０｜　７　　　８　　９　１０　　１１　１２　　１３
１１｜１４　　１５　１６　１７　　１８　１９　　２０
１２｜２１　　２２　２３　２４　　２５　２６　　２７
１３｜２８　　２９　３０　３１
この下に２月～６月、横に７月～１２月があり、休日を塗りつぶしています。
休日は祝日ではなくて当社の休日です。（２色）
セルの値は書式設定で「yyyy/mm/dd」を「dd」だけにして表示させています。
例えば１月２１日～２月２０日で塗りつぶしたセルの合計を出したいのです。（２色なので色別に）
数式ではダメなようですので、VisualBasciでもOKですので、
どなたか御教授いただけないでしょうか？
宜しくお願いします。

No.2 ベストアンサー 回答者： zap35 回答日時： 2007/10/01 20:15

多少汎用的に考えてユーザ定義関数にしてみました

以下のマクロをALT＋F11でVBE画面を開き、左上のVBA Projectでシート名を右クリックし「挿入」→「標準モジュール」で表示される画面に貼り付けて下さい。

VBE画面を閉じてワークシート画面に戻り
　=Csum(C8:I50,A3,A1,A2)
のように４つの引数を指定して式を入力します
　１番目：塗りつぶしたセルを数えるセル範囲
　２番目：数えたい色で塗られているセルアドレス
　３番目：開始日が入力されたセルアドレス
　４番目：終了日が入力されたセルアドレス

２番目の引数で指定するセルは、予め背景色を塗っておいてください。
また３、４番目のセルが日付型の値でない場合や、開始日＞終了日のときは#VALUE!エラーを返します

Function Csum(ByVal rng, trg, dt1, dt2 As Range) As Long
Dim r As Range
Dim tCidx
Dim fDate, tDate As Date
　tCidx = trg.Cells(1, 1).Interior.ColorIndex
　　If IsDate(dt1.Value) And IsDate(dt2.Value) Then
　　　　fDate = dt1.Value
　　　　tDate = dt2.Value
　　Else
　　　　Csum = ""
　　　　Exit Function
　　End If
　　If fDate > tDate Then
　　　　Csum = ""
　　　　Exit Function
　　End If
　　For Each r In rng
　　　　If r.Interior.ColorIndex = tCidx Then
　　　　　　If IsDate(r.Value) Then
　　　　　　　　If r.Value >= fDate And r.Value <= tDate Then
　　　　　　　　　　Csum = Csum + 1
　　　　　　　　End If
　　　　　　End If
　　　　End If
　　Next r
End Function

なおセルの背景色を変更する動作を行っても関数の再計算は自動的にされません。カレンダの日付を先に入力して、後から背景色を変更した場合は
　ALT＋Ctrl＋F9
で強制再計算させる必要があります。

この回答への補足

御回答有難うございます。
ほぼ自分の意図した物になってきましたが、
なんとか自動で再計算させる方法はないのでしょうか？
これが出来きたら完璧なるのですが。

補足日時：2007/10/02 09:58

No.3 回答者： zap35 回答日時： 2007/10/02 14:36

＃０２です

＞ほぼ自分の意図した物になってきましたが
ということはご自身で手を加えていただいたと言うことですね。参考になって幸いです。

私はきれいな方法で確実に強制再計算を自動化する方法を知りません。
Loop処理の中でSendkeysとDoEventsを用いて｛Alt＋Ctrl＋F9｝を一定間隔で発生させる方法は考えられますが、間隔をあまり短くすると普通の操作に支障が出るかもしれません。あるいはOnTimeメソッドでSendkeysを呼ぶのもアリでしょうし、Worksheet_CalculateイベントでSendkeysを呼ぶ方法も考えられます。

これらの方法は試していませんので、ご自身で色々とお試しください。

No.1 回答者： imogasi 回答日時： 2007/10/01 19:39

セルの塗りつぶし（文字のフォント色も同じ）は

（１）書式設定　書式ーセルーパターンー色指定
（２）条件付書式　書式ー条件付書式ー値が（式が）・・－色指定
の２つがあります。
ーー
Ｃ３は（１）で赤（セルパターン色）
Ｃ５は（２）で赤（セルパターン色）
を設定しました
Sub test01()
MsgBox Cells(3, "C").Interior.ColorIndex
MsgBox Cells(5, "C").Interior.ColorIndex
End Sub
を実行すると（１）は３、（２）は－４１４２（色設定なしと同じ）
になりました。
条件付貴書式の方の色判別は（Ｍｓｇｂｏｘはわざと表示用にしている。）
MsgBox Cells(5, "C").FormatConditions(1).Interior.ColorIndex
のようにしないとならないようです。
ーー
ですから、本件質問の場合は
（１）か（２）のどちらであるのか
（２）の場合は条件は何か
を書かないと、この質問に回答できません。
ーー
＞休日は祝日ではなくて当社の休日です
とあるところから推測すると、（１）のケースでないかと思う。
ーー
そこで
１月の場合
Sub test02()
Dim cl As Range
k = 1
For Each cl In Range("C9:i13")
If cl.Interior.ColorIndex = 3 Then
k = k + 1
Next
Cells(3, "Z") = k
End Sub
のようなコードを組むことになるが、１２ヶ月を１度に出すには
１月以外は、セルの情報が質問に具体的でないので、コードが書けない。
質問者が修正する力があれば、参考にしてください。

この回答へのお礼

お返事、有難うございます。
他の方から教えて頂いた方法で試してみたいと思います。
なかなか難しいですね・・・

お礼日時：2007/10/02 09:54