vba エクセルで提出期限の管理をしたい

VBA勉強中の初心者です。
添付画像のような表があったとして・・
・提出期限を過ぎていれば（今日より前の日付だった場合）、文字色を赤にする
・期限を守れていなくても提出実績があれば期限と実績を両方グレーの塗りつぶし、文字色は黒
・空白セルはそのまま
という処理をさせるチェックマクロを作ってみたいです。
上の表が今日の状態として、書式のない状態からチェックマクロを実行すると上のような書式になり、６月１日にチェックマクロを実行すると下のようになる。。というのが理想なのですが、そういったことはマクロで可能ですか？
質問のために表を２つ作っていますが実際は一つの表で文字色や背景色をその都度変更したいです。

ワークシート関数をEvaluateで判定しながらセルを移動していけばいいのかな？などぼんやりとしか思いつかないので切り口になるようなコードを提示頂けると助かります。

質問者からの補足コメント

• ありがとうございます。
  標準モジュールに設定し、実行ボタンを配置して他のブックは開いていない状態でボタンを押したときに発動を考えています。
  色塗りについては条件付き書式ではなく単純な色塗りをしたいです。
  ループさせる部分がまだよく理解できていないので質問させていただきました。

  No.1の回答に寄せられた補足コメントです。 補足日時：2015/05/27 10:40

• ありがとうございます。
  ・期限は設定されていないけれど実績はある
  ・期限がまだ先でも実績がある
  という太枠内を処理したいのですが、ひとつのfor~nextでは収まりませんか？
  
  頂いたコードの End sub前に追加してます。
  ------------
  For j = 3 To lastCol
  For i = 3 To lastRow Step 2
  If Cells(i + 1, j) <> "" Or Cells(i + 1, j).Interior.ColorIndex = 15 Then
  Cells(i, j).Resize(2).Interior.ColorIndex = 15
  End If
  Next i
  Next j

  
  No.2の回答に寄せられた補足コメントです。 補足日時：2015/05/27 22:24

• 更に補足ですが、
  No.2さんのコードの
  .Interior.ColorIndex = xlNone
  を削除、ふたつめのIfを
  If Cells(i + 1, j) <> "" Or Cells(i + 1, j).Interior.ColorIndex = 15 Then
  のように変更しています。
  実績が空欄でもグレーになっていれば塗りつぶし＆文字黒にしたいので。

    補足日時：2015/05/27 22:29

• ごめんなさい太線は分かりやすくしたかっただけで本題とは関係無いです。
  やりたいコトをまとめると
  ①　「灰色」に塗りつぶされているセルには手を付けない（フォントは「自動」に）
  ②　「期限」が本日以降でも「実績」に入力があればグレーの塗りつぶし＆黒字にする
  ③　「期限」が空白でも「実績」に入力があればグレーの塗りつぶし＆黒字にする
  ④　「期限」が本日より前で「実績」に入力がないものは赤字にする
  となります。。
  前回頂いたコードを少し修正して（補足）、続けて補足のコードを追加すれば思い通りの結果にはなったのですが、
  For j For i~Next i Next jのあとまたFor j For i~Next i Next jになるのでもう少しスマートなやり方はないかな？と思っただけです。

  No.3の回答に寄せられた補足コメントです。 補足日時：2015/05/28 01:31

No.4 ベストアンサー 回答者： tom04 回答日時： 2015/05/28 08:56

No.2・3です。

＞For j For i~Next i Next jのあとまたFor j For i~Next i Next jになるので・・・
No.2とNo.3のコードは重複している部分が多くありますので、
二つの操作をしても無駄に二重ループしているだけです。

当方の書き方も悪かったのですが、
No.2の方は　列　→　行　の順にループさせ、No.3の方は　行　→　列　と逆にしていました。
（どちらでも問題ありません）

さて、前回の「太線」の部分はそのセルに色を付けたい！という意味で太線にしていただけですね？

今までのコードはすべて消去し、↓のコードに変更してみてください。

Sub Sample3()
Dim i As Long, j As Long, lastRow As Long, lastCol As Long
lastRow = Cells(Rows.Count, "B").End(xlUp).Row
lastCol = Cells(2, Columns.Count).End(xlToLeft).Column
'//一旦フォント色を「自動」に
Range(Cells(3, "C"), Cells(lastRow, lastCol)).Font.ColorIndex = xlAutomatic
'//3行目～最終行まで1行おき
For i = 3 To lastRow Step 2
'//C列～最終列まで
For j = 3 To lastCol
With Cells(i, j)
'//セルが空白でない場合
If .Value <> "" Then
'//本日より前の場合
If .Value < Date Then
'//下のセルが空白ならば
If .Offset(1) = "" Then
'//④の処理
'//フォント色を「赤」に
.Font.ColorIndex = 3
'//下のセルにデータがあれば
Else
'//2セルを「灰色」に塗りつぶし
.Resize(2).Interior.ColorIndex = 15 '最初の質問の処理
End If
'//本日以降の場合
Else
'//②の処理
'//下のセルにデータがあれば
If .Offset(1) <> "" Then
'//2セルを「灰色」に塗りつぶし
.Resize(2).Interior.ColorIndex = 15
End If
End If
'//セルが空白の場合
Else
'//③の処理
'//下のセルにデータがあれば
If .Offset(1) <> "" Then
'//2セルを「灰色」に塗りつぶし
.Resize(2).Interior.ColorIndex = 15
End If
End If
End With
Next j
Next i
End Sub

これではどうでしょうか？m(_ _)m

この回答へのお礼

IFのネストってこうやるんですね・・・
どのIFやElseになにを書けばいいのか分かってなかったので二度手間なことしてました。
分かりやすく解説までつけて頂いて感謝感謝です。
何度もありがとうございました。

お礼日時：2015/05/28 22:55

No.3 回答者： tom04 回答日時： 2015/05/27 23:25

No.2です。

二つの補足を読ませていただくと、
結局
①　「灰色」に塗りつぶされているセルには手を付けない（フォントは「自動」に）
②　「期限」が本日以降でも「実績」に入力があれば太線にする
③　「期限」が空白でも「実績」に入力があれば太線にする
④　フォントの「赤」は前回通り
というコトでしょうね？

少し無駄があるかもしれませんが、↓のコードにしてみてください。

Sub Sample2()
Dim i As Long, j As Long, lastRow As Long, lastCol As Long
lastRow = Cells(Rows.Count, "B").End(xlUp).Row
lastCol = Cells(2, Columns.Count).End(xlToLeft).Column
Application.ScreenUpdating = False
Range(Cells(2, "A"), Cells(lastRow, lastCol)).Borders.Weight = xlThin
Range(Cells(3, "C"), Cells(lastRow, lastCol)).Font.ColorIndex = xlAutomatic
For i = 3 To lastRow Step 2
For j = 3 To lastCol
With Cells(i, j)
If .Interior.ColorIndex = xlNone Then
If .Value <> "" Then
If .Value < Date Then
If .Offset(1) = "" Then
.Font.ColorIndex = 3
Else
.Resize(2).Interior.ColorIndex = 15
End If
Else
If .Offset(1) <> "" Then
With .Resize(2)
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium
End With
End If
End If
ElseIf .Offset(1) <> "" Then
With .Resize(2)
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium
End With
End If
End If
End With
Next j
Next i
Application.ScreenUpdating = True
End Sub

こんなんではどうでしょうか？m(_ _)m

No.2 回答者： tom04 回答日時： 2015/05/27 08:37

こんにちは！

条件付き書式で対応できそうですが、VBAでの方法をご希望だというコトですので
一例です。
Sheetのレイアウトは画像の上側の配置通りとします。
（色を付けたいセルはC3セル以降）

Sub Sample1()
Dim i As Long, j As Long, lastRow As Long, lastCol As Long
lastRow = Cells(Rows.Count, "B").End(xlUp).Row
lastCol = Cells(2, Columns.Count).End(xlToLeft).Column
With Range(Cells(3, "C"), Cells(lastRow, lastCol))
.Interior.ColorIndex = xlNone
.Font.ColorIndex = xlAutomatic
End With
For j = 3 To lastCol
For i = 3 To lastRow Step 2
If Cells(i, j) <> "" And Cells(i, j) < Date Then
If Cells(i + 1, j) <> "" Then
Cells(i, j).Resize(2).Interior.ColorIndex = 15 '//←灰色25%
Else
Cells(i, j).Font.ColorIndex = 3
End If
End If
Next i
Next j
End Sub

※　当然のことですが、条件付き書式との共存はできませんので、万一条件付き書式が設定してある場合は
条件付き書式は削除しておいてください。m(_ _)m

No.1 回答者： MarcoRossiItaly 回答日時： 2015/05/27 07:39

どこのオブジェクトにそのマクロを保存し、どんなタイミングで発動させるのかを考えてください。

ブックを開いたときなのか、シートをアクティブにしたとき、編集したときなのか。それともマクロのダイアログから実行したり、特定のセルやボタンの類を押したときに発動させるのか。

色塗りの方法についても、条件を満たしたセルを単純に色塗りする方法と、条件付き書式を手動またはマクロで設定する方法があります。

セルの値については、VBA の Date 関数を使って比較すればよいでしょう。

ループは、

for each c in range(…
　if c.value = … then …
　…
　end if
next c

※ c はセルを表すオブジェクト変数

の形など。