アクセルデータシステム | MS Access（アクセス）データベースシステムの受託開発

日付の操作

#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 

>top

#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 

>top

#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


<実行結果>
水曜日

>top

#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

<実行結果>
今日は、平日です。

>top

#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は、木曜日です。

>top

#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歳です。

>top

#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) の値を返します。

>top