日付の操作 |
#1 指定日の月の初日を求める
使用例
'----------------------------------------------------------------- '概要 指定日の月の初日を求める '引数 datDay:日付または、日付関数 '----------------------------------------------------------------- Function MONTH_FIRST(datDay As Date) As Date MONTH_FIRST = DateSerial(Year(datDay), Month(datDay), 1) End Function Sub 指定日の月の初日() Debug.Print MONTH_FIRST("2010/1/20") End Sub <実行結果> 2010/01/01
#2 指定日の月末を求める
使用例
'----------------------------------------------------------------- '概要 指定日の月末を求める '引数 datDay:日付または、日付関数 '----------------------------------------------------------------- Function MONTH_END(datDay As Date) As Date MONTH_END = DateAdd("d", -1, DateAdd("m", 1, DateSerial(Year(datDay), Month(datDay), 1))) End Function Sub 指定日の月の末日() Debug.Print MONTH_END("2010/1/20") End Sub <実行結果> 2010/01/31
#3 曜日の日本語化
使用例
'----------------------------------------------------------------- '概要 曜日の日本語化 '引数 datDay:日付または、日付関数 '----------------------------------------------------------------- Function YOUBI(datData As Date) As String Dim sun, mon, tue, wed, thu, fri, sat As String sun = "日" mon = "月" tue = "火" wed = "水" thu = "木" fri = "金" sat = "土" YOUBI = Switch(Weekday(datData) = 1, sun _ , Weekday(datData) = 2, mon _ , Weekday(datData) = 3, tue _ , Weekday(datData) = 4, wed _ , Weekday(datData) = 5, thu _ , Weekday(datData) = 6, fri _ , Weekday(datData) = 7, sat _ ) End Function Sub 曜日の日本語化() Debug.Print YOUBI("2010/1/20") & "曜日" End Sub <実行結果> 水曜日
#4 日付が平日であるかどうかを調べる
使用例
'----------------------------------------------------------------- '概要 日付が平日であるかどうかを調べる。 '引数 datData : 日付(省略時、本日の日付が既定値) '返値 平日: True 土日:False '---------------------------------------------------------------- Function WEEKDAY_CK(Optional datData As Date) As Boolean If CLng(datData) = 0 Then datData = Date End If Select Case Weekday(datData) Case vbMonday To vbFriday WEEKDAY_CK = True Case Else WEEKDAY_CK = False End Select End Function Sub 日付が平日であるかどうか() If WEEKDAY_CK("2010/1/15") = True Then Debug.Print "今日は、平日です。" Else Debug.Print "今日は、土日です。" End If End Sub <実行結果> 今日は、平日です。
#5 日付から指定日を求め、土日にあたる時は金曜日の日付を返す
使用例
'----------------------------------------------------------------- '概要 日付から指定日を求め、土日にあたる時は金曜日の日付を返す '引数 datData : 日付 ' intMonth : 指定月を数字で指定(ex.1は1ヶ月後の意味です) ' intDay : 指定日を数字で指定(省略時は、指定月の前月末を返す) '---------------------------------------------------------------- Public Function SHITEIBI(datData As Date, intMonth As Integer, _ Optional intDay As Integer) As Date Dim datDay1 , datDay2 As Date If IsMissing(intDay) = True Then intDay = 1 End If datDay1 = DateAdd("m", intMonth, datData) datDay2 = DateSerial(Year(datDay1), Month(datDay1), intDay) Select Case Weekday(datDay2) Case 1: SHITEIBI = DateAdd("D", -2, datDay2) '日曜日にあたる時、金曜日にする Case 7: SHITEIBI = DateAdd("D", -1, datDay2) '土曜日にあたる時、金曜日にする Case Else: SHITEIBI = datDay2 End Select End Function Sub 日付から指定日を求める() '当月末 Debug.Print SHITEIBI("2010/1/15", 1) & "は、" & _ YOUBI(SHITEIBI("2010/1/20", 1)) & "曜日です。" '翌月の15日 Debug.Print SHITEIBI("2010/1/15", 1, 15) & "は、" & _ YOUBI(SHITEIBI("2010/1/20", 1, 15)) & "曜日です。" '翌月末 Debug.Print SHITEIBI("2010/1/15", 2) & "は、" & _ YOUBI(SHITEIBI("2010/1/20", 2)) & "曜日です。" '翌々月の25日 Debug.Print SHITEIBI("2010/1/15", 2, 25) & "は、" & _ YOUBI(SHITEIBI("2010/1/20", 2, 25)) & "曜日です。" '※曜日確認の為、ユーザー定義関数YOUBIを組み合わせました。 End Sub <実行結果> 2010/01/29は、金曜日です。 '31日は日曜日の為、前週金曜日の日付を返しました。 2010/02/15は、月曜日です。 2010/02/26は、金曜日です。 '28日は日曜日の為、前週金曜日の日付を返しました。 2010/03/25は、木曜日です。
#6 年齢を求める
使用例
Function NENREI(Birthday As Date) As Integer Dim datDay As Date datDay = DateSerial(Year(Now), Month(Birthday), Day(Birthday)) If DateDiff("yyyy", Birthday, Now) < 0 Then Exit Function If Date < datDay Then NENREI = DateDiff("yyyy", Birthday, Now) - 1 Else NENREI = DateDiff("yyyy", Birthday, Now) End If End Function Sub 年齢() Debug.Print NENREI("1980/1/1") & "歳です。" Debug.Print NENREI("1990/1/1") & "歳です。" End Sub <実行結果> 30歳です。 20歳です。
#7 時間経過を求める
使用例
Sub Timerテスト() Dim cnn As New ADODB.Connection Dim rst As New ADODB.Recordset Dim i As Integer Dim sglStart, sglFinish As Single '開始のタイマーをセットします。 sglStart = Timer Set cnn = CurrentProject.Connection With rst '※テーブル tblTimerTest に 1〜1000のデータを追加します。 .Open "tblTimerTest", cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect For i = 1 To 1000 .AddNew .Fields(0) = i .Update .MoveNext Next i End With rst.Close cnn.Close: Set cnn = Nothing '終了のタイマーをセットします。 sglFinish = Timer Debug.Print "この処理は、" & CCur(sglFinish - sglStart) & "秒かかりました。" End Sub <実行結果> この処理は、0.9531秒かかりました。※Timer関数は、午前0時から経過した秒数を表す単精度浮動小数点数型 (Single) の値を返します。