VBAで日付の検索して表示させる

Question

社内ツールを作成しています。
今日の日付から計算を行い、契約終了日から決められた日数を切っている契約案件を表示させようと思っています。
例:契約終了日が2017年9月20日だとして契約終了日まで30日を切っている契約案件Aを表示させる。
契約も年単位のものもあるので年も含めた計算を行いたいと考えています。
作成途中のソースコードです。

'ub 検索()

Dim シート名 As Worksheet
Dim 日付 As Date
Dim getlastday As Long
Dim 契約終了を設定している最初のセル As Long
Dim 契約終了を設定している最後のセル As Long

MsgBox Date'今日の日付を返す

End Sub'

色を変えてmsgboxで表示させようと考えています。
VBAはほぼ、初心者で書籍やサイトで調べましたが全く分かりません。
どうか、皆さんのお力をお借りしたいと思います。
よろしくお願い致します。

追記―――――――――――――――――――――――――――――――――――――――――――――――
社内ツールなので詳しくは載せらないのはご了承ください。

契約開始日も終了日も契約によっては月初や月末ではないので扱う営業さん次第なのでバラバラなんですね。

簡単にまとめてみました。
上は行番号です。

|aa6 |ab6 |ac6 |ad6 |ae6 |af6 |ag6 |ah6 |ai6 |aj6 |ak6 |al6 |am6|

|契約開始年|年|契約開始月|月|契約開始日|日||から|契約終了年|年|契約終了月|月|契約終了日|日|
|2017 |年|5 |月|28 |日|から |2017 |年|9 |月|1 |日|

下にもずっと続きます。
Aの列にはには営業の方の名前があります。

Comments

[tsuemura]

ソースコードはコードブロック(```)で囲んでください。また、条件に応じて色をつけるのであれば、VBAではなくExcelの条件付き書式で実現可能です。あえてVBAで実現したい理由は何なのでしょうか？

[HISUI]

一か月の契約などこちらで決めた日数を最初から切っている案件もありますし、こちらで決めた日数は固定日数にする予定なので条件付き書式じゃ当てはまらないかなと思ったのでVBAでと思ったのですが、条件付き書式でいい方法があれば教えていただきたいと思います。

[kikukiku]

Excel上の具体的なデータを示した方が良いと思います。現在の情報のみですと答えずらいです。

[HISUI]

検索というボタンを作成し、それを押すと作動するようにする予定で10人程度の営業全員のデータを格納し、契約終了後も削除はしないのでデータ量は大きいと思われます。

[HISUI]

一応、Excelのオートフィルターで営業側で自分の名前を選択してもらう予定です。

Answer 1

条件付き書式にするか、VBAにするか

今回の質問ではチェックを行うタイミングやデータ量について触れられていませんが、これらによって実装方法も変わってくると思います。

・契約終了日を入力した時点で即時チェックしたい場合
⇒ 条件付き書式で即座に判定結果がわかる方が使い勝手がよさそうです。

・複数件入力したデータを（ボタン押下などのタイミングで）一括チェックしたい場合
⇒ １件ずつでなく、一括でチェックしたいのならVBAの方が向いています。

多少のスクロールで見渡せる程度のデータ量であれば、条件付き書式で色付けすれば把握できそうです。
目視で確認するのが大変なほどのデータ量になるのであれば、VBAでまとめてチェック、まとめて結果報告としたほうが確実そうです。

チェック処理を関数化する

いずれにしても、入力された契約終了年・月・日と、警告開始日数をもとに現在日時が警告すべき日付かどうかを判断する必要があります。

この部分を関数化しておけば条件付き書式でもVBAマクロでも利用できると思います。

・入力された年・月・日から契約終了日を作成する
・契約終了日から指定日数をマイナスする。（警告開始日）
・当日の日付が警告開始日以降であれば、警告対象と判断する。

以下は上記の判定を行うサンプルコードです。

Function IsWarning(ByVal vY, ByVal vM, ByVal vD, ByVal vNissu As Integer) As Boolean
    
    Dim ret As Boolean    '戻り値
    ret = False    '初期値はFalse
    
    '入力チェック
    If IsDate(vY & "/" & vM & "/" & vD) = False Then
        '年月日を連結しても日付型にならない場合
        '判断不能のため警告しない
        IsWarning = False
        Exit Function
    End If
    
    '契約終了日（引数の年・月・日から契約終了日を生成する）
    Dim dt As Date
    dt = CDate(vY & "/" & vM & "/" & vD)
    
    '警告表示開始日（契約終了日 - 警告日数）
    Dim dtWarning As Date
    dtWarning = DateAdd("D", vNissu * -1, dt)
    
    '当日日付
    Dim dtToday As Date
    dtToday = CDate(Format(Now, "YYYY/MM/DD"))
    
    If dtToday > dtWarning Then
        '当日日付が警告表示開始日を超えていたら戻り値＝True
        ret = True
    End If
    IsWarning = ret
    
End Function

これを標準モジュールに記述しておけばシート上や条件付き書式などでも利用できると思います。

使用例）
AN6セルに=IsWarning(AH6, AJ6, AL6, 30)と記述した場合、
AH6～AL6の入力内容が契約終了まで30日以下の場合TRUE、30日以上の場合FALSEが表示される

参考になれば幸いです。

Answer 2

年と月と日が分かれているんですね。
であれば、下記のように結合してやれば、契約開始日、契約終了日が求められると
思いますので、あとは、tsuemuraさんのやり方で目的は達成すると思います。

=A1 &"/"& B1&"/" & C1

Answer 3

VBAを使わず、条件付き書式で実行する前提ですが、

今日の日付	アラート日数
2017/9/1	60

案件名	契約開始日	契約終了日	残日数
A	2017/1/1	2017/12/31	(契約終了日-今日の日付)
B	2017/1/1	2017/10/31	(契約終了日-今日の日付)
C	2017/1/1	2017/9/30	(契約終了日-今日の日付)

のようにして、
条件付き書式で、残日数 < アラート日数としてはいかがでしょうか。

固定の日数にしたいということでしたら、アラート日数を編集不可にしてしまってください。

Answer 4

たくさんの回答ありがとうございました。
結果的にVBAを前に使っていた弊社の技術者の先輩とともに完成させました。

'Dim ws As Worksheet
Dim fname As String

Dim 既存ファイル名 As String
Dim 保存ファイル名 As String

    Dim 契約終了日 As Long
    Dim 終了日まで As Long
    Dim 確認 As Variant
    

Dim 契約名 As String '契約終了日が60日を切っている契約を載せる

Dim ah As Range
Dim aj As Range
Dim al As Range

Worksheets("シート名").Select

Dim enddate As Date
Dim i As Integer

For i = 6 To 65

enddate = DateSerial(Range("AH" & Format(i)), Range("AJ" & Format(i)), Range("AL" & Format(i)))

'MsgBox Date
MsgBox enddate 'ここで今日の日付から契約終了日を引いて60日未満の契約名を載せたい。

'MsgBox todaydate - Date

If (enddate - Date) < 60 Then
Range("O" & Format(i)).Interior.Color = RGB(200, 200, 200)
End If
Next

End Sub'

このように作成しました。

改めて、たくさんの回答ありがとうございました。
また、機会があればよろしくお願いいたします。

Comments

[jawa]

まずは解決されたようで何よりです。
採用されたコードですが、見る限り60行くらいをループして、各行毎に契約終了日をメッセージボックスで表示し、判定結果によっては色を付ける、という処理になっているようです。
大量データを扱う想定のようですのでメッセージボックスは暫定的に表示しているだけだと思いますが、メッセージ表示を除くと残るのは判定結果によって色を付ける処理だけになりますよね。

これであれば、わざわざボタンを押したときの処理としてVBAで行わなくても、Excelシートの機能で条件付き書式というものを使えばセルに値を入力した時点で判定されて色を付けることができます。
（それを提案してくれたのがtsuemuraさんのアドバイスです。）

例えばO6セルの条件付き書式として「数式を使用して書式設定」を選択し、
=(DATE(AH6,AJ6,AL6)-TODAY())<60
という数式を入力して、条件を満たしたときの書式として任意の背景色を設定しておけば、契約終了日まで60日を切っていればO6セルに色がつくようになります。
ちなみに私のアドバイスのIsWarning関数を実装した場合は、数式の部分が
=IsWarning(AH6,AJ6,AL6,60)
となります。

採用されたコードですと今後データ量が増えた場合に`For i = 6 To 65`の`65`の部分を都度変更するか、最終行を自動で見つける処理を組み込まなければなりません。
条件付き書式ならセルに書式をコピーするだけで適用できるというのもメリットかもしれません。

解決済ですので要らぬお世話かもしれませんが、色を付けるだけの処理なら条件付き書式というのも検討する価値がありそうだと思いましたので、コメントさせていただきました。
参考までに。

[HISUI]

わざわざ、コメントしていただきありがとうございます。
msgboxは翌日の改修で消して削除して速度を上げることが出来たのですがjawaさんの仰る通り、色を付ける動作のみなのでデータももっと増えていくので今、改修を行っているのですが困っています。
結局、昨日質問を新たに投稿した問題に繋がっているんですよね。
来月から初現場にアサインされるのでそれまでには何とか上司から太鼓判を押されるツールを作成できるように頑張ります。