excel vbaでマクロが作りたいのですが

質問

マクロ初心者です。

番号　　貸出日　　返却予定日　図書名　　貸出先　　　返却日
１　　　2012/12/5　2013/1/5　　マクロ　　ジョニーさん

上のような表を作成していて、予定日を過ぎても返却がない場合、自動的に番号欄に網掛けをして、実際に返却されて返却日が入力されたら、網掛けが消えるというマクロがつくりたいのですが。
素人なりに試行錯誤していますが、なかなか出来ずに困っています。
どなたか、わかりやすく教えていただけませんか。

回答No.1

mt2008 · ベストアンサー

どうしてもマクロでやりたいのでしたら話は別ですが、この内容でしたら条件付き書式で可能です。
添付の図ではA2セルに以下のような条件付き書式を設定しています。

・数式を使用して、書式設定するセルを決定
=AND($C2<NOW(),$F2="")

お礼

さっそくの回答ありがとうございました。
思いどおりの結果が得られました。
ありがとうございました。
もし、マクロで作るとすれば、めんどうなのでしょうか？

回答No.3

tom04

こんにちは！
横からお邪魔します。

No.1さんが仰っているように条件付き書式の方がはるかに簡単です。

マクロで行うとなると
（1）BOOKを開いたときに、一旦マクロを走らせる必要がある。
（2）操作SheetのF列に入力があった場合は「塗りつぶしなし」にする必要がある。

上記二つのマクロを組む必要があります。

どうしてもマクロで！というコトであれば・・・一例です。

まずAlt＋F11キー　→　画面の左側にある「This Workbook」をダブルクリック！
VBE画面に↓のコードをコピー＆ペーストしてください。
※　操作したいSheet名は「Sheet1」とします。

Dim i As Long 'この行から
Private Sub Workbook_Open()
Dim wS As Worksheet '←「Sheet1」の部分は実際のSheet名に！
Set wS = Worksheets("Sheet1")
Application.ScreenUpdating = False
For i = 2 To wS.Cells(Rows.Count, 1).End(xlUp).Row
If wS.Cells(i, "C") < Date Then
If Cells(i, "F") = "" Then
Cells(i, "A").Resize(1, 6).Interior.ColorIndex = 36
Else
Cells(i, "A").Resize(1, 6).Interior.ColorIndex = xlNone
End If
End If
Next i
Application.ScreenUpdating = True
End Sub 'この行まで

次に画面左下の操作したいSheet見出し上で右クリック　→　コードの表示　→　VBE画面に
↓のコードをコピー＆ペーストします。

Private Sub Worksheet_Change(ByVal Target As Range) 'この行から
If Application.Intersect(Target, Range("F:F")) Is Nothing Or Target.Count <> 1 Then Exit Sub
i = Target.Row
If Target <> "" Then
Cells(i, "A").Resize(1, 6).Interior.ColorIndex = xlNone
End If
End Sub 'この行まで

最後に「マクロ有効BOOK」として保存します。

以上で操作は終わりです。

※　条件付き書式が設定してある場合は色の変更ができませんので、
セルの塗りつぶしの設定は解除しておく必要があります。

このような操作を考えると「条件付き書式」の方が
はるかに簡単なコトがお判りだと思います。m（_ _）m

お礼

丁寧な説明ありがとうございます。
なるほど、はるかに条件付き書式が楽ですね。
マクロの文章の意味がまだよく理解できませんが、マクロでもできています。
いまから勉強します。ありがとうございました。

回答No.2

mt2008

> もし、マクロで作るとすれば、めんどうなのでしょうか？

はい、面倒です（笑）。
コード自体は以下の様に簡単なものですが、人に使ってもらう物の場合、マクロと言うだけでどんな簡単な物でもいつまでも作成者に問い合わせや修正依頼が来たりしますのでその辺りが……。

Private Sub Worksheet_Change(ByVal Target As Range)
　　For i = 2 To Cells(Rows.Count, 3).End(xlUp).Row
　　　　Cells(i, 1).Interior.Pattern = xlNone
　　　　If IsDate(Cells(i, 3)) And Cells(i, 3) < Now() And IsDate(Cells(i, 6)) = False Then
　　　　　　Cells(i, 1).Interior.Pattern = xlGray25
　　　　End If
　　Next i
End Sub

お礼

おっしゃるとおりです。
自分がよく理解していないのに問い合わせされても困りますよね。
親切にありがとうございました。