VBAで月末の日付を取得する

明日から月初の第一営業日を迎え、
請求書対応でエクセルを多用するので
少しでも時間削減をすべく前回のコードに手を加えたいと思う。

内容としては、シートをコピー後に
対象期間を書き換えるという単純入力作業があるので
それを今回は改善したいと思う。

例えば

A B C
1 2013/07/01 2013/07/31

というセルが仮にあったとすると、
シートをコピーした後に、

A B C
1 2013/08/01 2013/08/31

と、手入力で書き換えている。

これも時間にしては大した事ないが、
今回でいうと60件ほど、この単純作業が想定されるので
VBAでシートコピーのついでに期間も自動で書き換えたい。

 

まず、DateAdd関数なるものを利用してみる。

DateAdd関数は無効な日付を返しません。たとえば次の例は”97/01/31″に1ヶ月を加えていますが、DateAdd関数が返すのは”97/02/28″であり”97/02/31″ではありません。

確かに月末最終日付は変動するので
そのような処理がないと困りますね。

A1とC1のセルに日付を入れてテストを行う。

0831

Sub MonthAdd()
Dim StartDate As String
Dim StartDateNew As String
StartDate = Range("A1")
StartDateNew = DateAdd("m", 1, StartDate)
Range("A1").Activate
ActiveCell = StartDateNew
Dim EndDate As String
Dim EndDateNew As String
EndDate = Range("C1")
EndDateNew = DateAdd("m", 1, EndDate)
Range("C1").Activate
ActiveCell = EndDateNew
End Sub

で、早速実行してみると、
8/31の1ヵ月後は9/30と返してくれたが、

0930

もう一度実行すると9/30の1ヵ月後は10/30と返してくる、

1030

ただ10月の最終日は10/30ではなく10/31である。
これでは使い道がない。

 

で、もうちょっと調べてみると
下記のページを見つけた。

今月/前月/翌月の月末日を取得する

なるほど、これであれば上記コードでいうところの変数StartDateNewの
当月末を取得するかたちで処理ができそうである。

で、作成したコードがこちら

Sub MonthAdd()
Dim StartDate As String
Dim StartDateNew As String
StartDate = Range("A1")
StartDateNew = DateAdd("m", 1, StartDate)
Range("A1").Activate
ActiveCell = StartDateNew
Dim EndDateNew As String
EndDateNew = DateSerial(Year(StartDateNew), Month(StartDateNew) + 1, 0)
Range("C1").Activate
ActiveCell = EndDateNew
End Sub

1031

 

思い通りの処理ができて満足です。

 

ついでに支払日も自動で日付挿入をしようと思う。

15日払いなどであれば、月を+1にしていくだけであるが、
末払いであれば前述のDateSerial関数で末日を取得する必要がある。

単純にIf~Elseで処理を分岐させるだけであるが、
ただ、ここで問題なのが末日か否かの判定である。

色々と考えたが、支払日は基本的に五十日(ごとおび)で設定しており、
27日より後ろの末日以外の日が指定支払日になる事は、
少なくとも、うちの会社では考えられない。

そのようなわけで、日の値(Day)が28より小さければ末払いではなく
28以上であれば末払いと判定をする事にした。
(2月の末日が28日で、うるう年でも29日なので)

Sub PaymentDate()
Dim PaymentDate As String
Dim PaymentDateNew As String
PaymentDate = Range("A1")
If Day(PaymentDate) < 28 Then
PaymentDateNew = DateAdd("m", 1, PaymentDate)
Else
PaymentDateNew = DateSerial(Year(PaymentDate), Month(PaymentDate) + 2, 0)
End If
Range("A1").Activate
ActiveCell = PaymentDateNew
End Sub

※27日より後ろの支払日の場合このコードは使えないので注意。

 

今後も部分的に切り出して単純作業を自動化していきたいと思う。

コメントを残す

メールアドレスが公開されることはありません。 が付いている欄は必須項目です