AccessVBA 常に直近◯ヶ月のデータを自動で抽出する設定を行う

日付の入ったテーブルから、その日付を元に例えば直近３ヶ月間など常に一定期間のデータを抽出したい場合があります。

フォーム画面で抽出期間を設定し、コマンドクリック時に抽出することも可能ですが、常に一定期間の場合、手動で期間を設定する手間を省くことができます。

以下、VBAの記述

'-----------------------------------------------------------------------------------------

'サンプルコードでは[元データ]というテーブルから[抽出データ]というテーブルに本日を起算日として直近3ヶ月のデータを抽出する設定です

Function selectData

Dim db As Database

Dim rst As Recordset

Dim rst1 As Recordset

Dim strSQL As String

Dim cntMon As Integer '基準日=本日の月

Dim startYear As Integer '開始日の年部分

Dim startMon As Integer '開始日の月部分

Dim startDay As Date   '自動で設定する開始日

Dim endDay As Date '自動で設定する終了日

'今月を抽出

cntMon = Month(Date())

'今月が何月かによって処理を分岐させる-----直近3ヶ月なので以下の通り

’開始日ば昨年にずれる場合の開始月 = 基準月（今月）+12 - 抽出期間（3ヶ月)

Select case cntMon

Case Is < 4

startMon = cntMon + 9

startYear = Year(Date())-1

Case Else 

startMon = cntMon - 3

startYear = Year(Date())

End Select

'例えば本日が2017年3月4日だとすると開始日（startDay)は2016年12月1日、終了日(endDay)は、2017年3月1日となります

startDay = DateSerial(startYear,startMon,1)

endDay = DateSerial(Year(Date()),Month(Date()),1)

Docmd.RunSQL "DELETE*FROM [抽出データ];"

Set db = CurrentDb

’開始日は等号で含めて終了日は不等号で含めない

strSQL = "SELECT [元データ].* FROM [元データ] "

strSQL = strSQL & "WHERE [元データ].日付 >= #" & startDay & "# "

strSQL = strSQL & "AND [元データ].日付 < #" & endDay & "#;"

Set rst1 = Db.OpenRecordSet(strSQL,dbOpenSnapshot)

Set rst = Db.OpenRecordSet("[抽出データ]")

If rst1.RecordCount <> 0 then

rst1.Movefirst

Do until rst1.EOF

rst.Addnew

'追加処理

rst.Update

rst1.Movenext

Loop

db.Close

Set db = Nothing

End if

End Function

'----------------------------------------------------------------------------------------------

以上、VBA記述終わり。