【Excel VBA】日付を扱いやすくするクラス

いつも即実用という感じのものばかり作っているので、たまにはコアな匂いのするものも書いてみようかと思いたってやってみました。

VBAで日付を扱うのはそんなに難しいことではないのだけれどなんか面倒くさいので、少しだけでもこのめんどくささが解消されればいいな、と思って書いてみました。

コードが長いのでたたんでおります。開いてコピってください(笑)

【2018年4月30日追記】

コード内でクラスをインスタンス化した時に今日の日付を保持するようにしていましたが、そうするとクラスをインスタンス化してずっとそのままにしておくと、今日が昨日や一昨日になってしまうこともあるため、コードを書き直しました。

DateCalculatorClass コード

'---------------------------------------------------------------------------------------
' Module    : DateCalculatorClass
' Author    : Plus One Software
' Date      : 2018/04/27
' Purpose   :
'---------------------------------------------------------------------------------------
Option Explicit
Private Const HOLIDAY_URL As String = "https://holidays-jp.github.io/api/v1/date.csv"
'---------------------------------------------------------------------------------------
' Procedure : Today
' Author    : Plus One Software
' Date      : 2018/04/27
' Purpose   :
' Return    : Date
'---------------------------------------------------------------------------------------
'
Public Property Get Today() As Date
    Today = Date
End Property
'---------------------------------------------------------------------------------------
' Procedure : Yesterday
' Author    : Plus One Software
' Date      : 2018/04/27
' Purpose   :
' Return    : Date
'---------------------------------------------------------------------------------------
'
Public Property Get Yesterday(Optional aDay As Date) As Date
    aDay = setDate(aDay)
    Yesterday = aDay - 1
End Property
'---------------------------------------------------------------------------------------
' Procedure : Tomorrow
' Author    : Plus One Software
' Date      : 2018/04/27
' Purpose   :
' Return    : Date
'---------------------------------------------------------------------------------------
'
Public Property Get Tomorrow(Optional aDay As Date) As Date
    aDay = setDate(aDay)
    Tomorrow = aDay + 1
End Property
'---------------------------------------------------------------------------------------
' Procedure : Weekday
' Author    : Plus One Software
' Date      : 2018/04/27
' Purpose   :
' Return    : String
'---------------------------------------------------------------------------------------
'
Public Property Get Weekday(Optional aDay As Date, Optional withBrackets As Boolean, _
                    Optional fullString As Boolean, Optional withEnglish As Boolean) As String
    aDay = setDate(aDay)
    Dim w As String
    If withEnglish Then
        If fullString Then
            w = WorksheetFunction.Text(aDay, "dddd")
        Else
            w = WorksheetFunction.Text(aDay, "ddd")
        End If
    Else
        If fullString Then
            w = WorksheetFunction.Text(aDay, "aaaa")
        Else
            w = WorksheetFunction.Text(aDay, "aaa")
        End If
    End If
    If withBrackets Then
        w = "(" & w & ")"
    End If
    Weekday = w
End Property
'---------------------------------------------------------------------------------------
' Procedure : DaysAfter
' Author    : Plus One Software
' Date      : 2018/04/27
' Purpose   :
' Return    : Date
'---------------------------------------------------------------------------------------
'
Public Property Get DaysAfter(days As Integer, Optional startDate As Date) As Date
    startDate = setDate(startDate)
    DaysAfter = startDate + days
End Property
'---------------------------------------------------------------------------------------
' Procedure : DaysBefore
' Author    : Plus One Software
' Date      : 2018/04/27
' Purpose   :
' Return    : Date
'---------------------------------------------------------------------------------------
'
Public Property Get DaysBefore(days As Integer, Optional startDate As Date) As Date
    startDate = setDate(startDate)
    DaysBefore = startDate - days
End Property
'---------------------------------------------------------------------------------------
' Procedure : DiffYears
' Author    : Plus One Software
' Date      : 2018/04/27
' Purpose   :
' Return    : Date
'---------------------------------------------------------------------------------------
'
Public Property Get DiffYears(d1 As Date, Optional d2 As Date) As Integer
    d2 = setDate(d2)
    DiffYears = DateDiff("yyyy", d1, d2)
End Property
'---------------------------------------------------------------------------------------
' Procedure : DiffMonths
' Author    : Plus One Software
' Date      : 2018/04/27
' Purpose   :
' Return    : Date
'---------------------------------------------------------------------------------------
'
Public Property Get DiffMonths(d1 As Date, Optional d2 As Date) As Integer
    d2 = setDate(d2)
    DiffMonths = DateDiff("m", d1, d2)
End Property
'---------------------------------------------------------------------------------------
' Procedure : DiffWeeks
' Author    : Plus One Software
' Date      : 2018/04/27
' Purpose   :
' Return    : Date
'---------------------------------------------------------------------------------------
'
Public Property Get DiffWeeks(d1 As Date, Optional d2 As Date) As Integer
    d2 = setDate(d2)
    DiffWeeks = DateDiff("ww", d1, d2)
End Property
'---------------------------------------------------------------------------------------
' Procedure : DiffDays
' Author    : Plus One Software
' Date      : 2018/04/27
' Purpose   :
' Return    : Date
'---------------------------------------------------------------------------------------
'
Public Property Get DiffDays(d1 As Date, Optional d2 As Date) As Integer
    d2 = setDate(d2)
    DiffDays = DateDiff("d", d1, d2)
End Property
'---------------------------------------------------------------------------------------
' Procedure : EOMonth
' Author    : Plus One Software
' Date      : 2018/04/27
' Purpose   :
' Return    : Date
'---------------------------------------------------------------------------------------
'
Public Property Get EOMonth(Optional aDay As Date, Optional months As Integer) As Date
    aDay = setDate(aDay)
    EOMonth = WorksheetFunction.EOMonth(aDay, months)
End Property
'---------------------------------------------------------------------------------------
' Procedure : HowOld
' Author    : Plus One Software
' Date      : 2018/04/27
' Purpose   :
' Return    : Integer
'---------------------------------------------------------------------------------------
'
Public Function HowOld(birthday As Date, Optional aDate As Date) As Integer
    aDate = setDate(aDate)
    Dim y As Integer
    y = DiffYears(birthday, aDate)
    y = y + (Format(birthday, "mmdd") > Format(aDate, "mmdd"))
    HowOld = y
End Function
'---------------------------------------------------------------------------------------
' Procedure : IsHoliday
' Author    : Plus One Software
' Date      : 2018/04/27
' Purpose   : 引数で指定された日付が祝日であるかどうか判定する
' Return    : Variant:祝日であれば祝日名を返す。祝日でなければ False
'---------------------------------------------------------------------------------------
'
Public Function IsHoliday(d As Date) As Variant
    Dim hol As Variant
    hol = GetHolidayList()
    Dim i As Integer
    For i = 0 To UBound(hol)
        If d = CDate(hol(i, 0)) Then
            IsHoliday = hol(i, 1)
            Exit Function
        End If
    Next i
    IsHoliday = False
End Function
'---------------------------------------------------------------------------------------
' Procedure : getHolidayList
' Author    : Plus One Software
' Date      : 2018/04/27
' Purpose   : getCsvFromWeb 関数で取得した文字列データを二次元配列に整形して返す
' Return    : Variant:「祝日の日付 , 祝日名」の配列
'---------------------------------------------------------------------------------------
'
Public Function GetHolidayList() As Variant
    Dim line
    line = Split(getCsvFromWeb(HOLIDAY_URL), vbLf)
    If Not line(0) Like "2???-??-??,*" Then
        Call Err.Raise(555, , "祝日情報を取得できませんでした")
        Exit Function
    End If
    Dim data
    ReDim data(UBound(line) - 1, 1)
    Dim i As Integer
    For i = 0 To UBound(line) - 1
        data(i, 0) = Split(line(i), ",")(0)
        data(i, 1) = Replace(Split(line(i), ",")(1), """", "")
    Next i
    GetHolidayList = data
End Function
'---------------------------------------------------------------------------------------
' Procedure : getCalendar
' Author    : Plus One Software
' Date      : 2018/04/27
' Purpose   : 引数dで指定した日付を含む月のカレンダーを返す。
' Return    : Variant:7行 7列(0 to 6, 0 to 6)の二次元配列が得られる。
' Return    : shortName はデフォルトで True。
'      短縮した曜日名を使用しないとき False を指定する。
'---------------------------------------------------------------------------------------
'
Public Function GetCalendar(Optional d As Date, Optional shortName As Boolean = True) As Variant
    d = setDate(d)
    Dim yr As Integer, mm As Integer
    yr = Year(d)
    mm = Month(d)
    Dim beginDay As Integer, endDate As Integer
    beginDay = WorksheetFunction.Weekday(DateSerial(yr, mm, 1)) - 1
    endDate = Day(WorksheetFunction.EOMonth(d, 0))
    Dim w(6, 6)
    Dim i As Integer, j As Integer, dayCount As Integer
    For i = 0 To 6
        w(0, i) = WeekdayName(i + 1, shortName)
    Next i
    dayCount = 1
    For i = beginDay To 6
        w(1, i) = DateSerial(yr, mm, dayCount)
        dayCount = dayCount + 1
    Next i
    For i = 2 To 6
        For j = 0 To 6
            w(i, j) = DateSerial(yr, mm, dayCount)
            dayCount = dayCount + 1
            If dayCount > endDate Then GoTo finish
        Next j
    Next i
finish:
    GetCalendar = w
End Function
'---------------------------------------------------------------------------------------
' Procedure : GetDatesOfFixedDay
' Author    : Plus One Software
' Date      : 2018/04/27
' Purpose   : ある月(引数 yr/mm)の特定の曜日(wd : 1~7=日~土)の日付をすべて取得する
' Return    : Variant:日付が格納された一次元配列を返す
'---------------------------------------------------------------------------------------
'
Public Function GetDatesOfFixedDay(wd As Integer, Optional yr As Integer, Optional mm As Integer) As Variant
    If yr = 0 Then yr = Year(Date)
    If mm = 0 Then mm = Month(Date)
    If wd > 7 Or yr < 1900 Or mm > 12 Or mm < 1 Then
        Err.Raise 6
        Exit Function
    End If
    Dim endDate As Integer
    endDate = Day(WorksheetFunction.EOMonth(DateSerial(yr, mm, 1), 0))
    Dim d() As Variant
    Dim td As Date, tdd As Integer, i As Integer, cnt As Integer
    For i = 1 To endDate
        td = DateSerial(yr, mm, i)
        tdd = WorksheetFunction.Weekday(td)
        If tdd = wd Then
            ReDim Preserve d(cnt)
            d(cnt) = td
            cnt = cnt + 1
        End If
    Next i
    GetDatesOfFixedDay = d
End Function
'---------------------------------------------------------------------------------------
' Procedure : GetDatesOfFixedWeek
' Author    : Plus One Software
' Date      : 2018/04/27
' Purpose   : ある月(引数 yr/mm)の第weekNum週の日付をすべて取得する
' Return    : Variant:日付が格納された一次元配列を返す
'---------------------------------------------------------------------------------------
'
Public Function GetDatesOfFixedWeek(weekNum As Integer, Optional yr As Integer, Optional mm As Integer) As Variant
    If yr = 0 Then yr = Year(Date)
    If mm = 0 Then mm = Month(Date)
    If weekNum < 1 Or weekNum > 6 Or yr < 1900 Or mm < 1 Or mm > 12 Then
        Err.Raise 6
        Exit Function
    End If
    Dim d As Date
    d = DateSerial(yr, mm, 1)
    Dim data As Variant
    data = GetCalendar(d)
    Dim wd(6) As Date
    Dim i As Integer
    For i = 0 To 6
        wd(i) = DateSerial(yr, mm, data(weekNum, i))
    Next i
    GetDatesOfFixedWeek = wd
End Function
'---------------------------------------------------------------------------------------
' Procedure : GetAnnualDateList
' Author    : Plus One Software
' Date      : 2018/04/27
' Purpose   : 指定された年の日付のリストを作成する
' Return    : Variant
'---------------------------------------------------------------------------------------
'
Public Function GetAnnualDateList(yr As Integer, Optional direction As Integer = xlVertical) As Variant
    If yr < 1900 Then
        Err.Raise 6
        Exit Function
    End If
    Dim endDate As Integer
    Dim hD(11, 30)
    Dim vD(30, 11)
    Dim i As Integer, j As Integer, m As Integer, d As Integer
    For i = 1 To 12
        endDate = Day(WorksheetFunction.EOMonth(DateSerial(yr, i, 1), 0))
        For j = 1 To endDate
            m = i - 1
            d = j - 1
            hD(m, d) = DateSerial(yr, i, j)
            vD(d, m) = DateSerial(yr, i, j)
        Next j
    Next i
    If direction = xlHorizontal Then
        GetAnnualDateList = hD
    ElseIf direction = xlVertical Then
        GetAnnualDateList = vD
    End If
End Function
'---------------------------------------------------------------------------------------
' Procedure : GetMonthDatesList
' Author    : Plus One Software
' Date      : 2018/04/27
' Purpose   : 指定されたyr年mm月の日付のリストを作成する
' Return    : Variant:日付が格納された一次元配列を返す
'---------------------------------------------------------------------------------------
'
Public Function GetMonthDatesList(Optional yr As Integer, Optional mm As Integer) As Variant
    If yr = 0 Then yr = Year(Date)
    If mm = 0 Then mm = Month(Date)
    If yr < 1900 Or mm < 1 Or mm > 12 Then
        Err.Raise 6
        Exit Function
    End If
    Dim data As Variant
    data = GetAnnualDateList(yr)
    Dim md() As Date
    Dim endDate As Integer
    endDate = Day(WorksheetFunction.EOMonth(DateSerial(yr, mm, 1), 0)) - 1
    ReDim Preserve md(endDate)
    Dim i As Integer
    For i = 0 To endDate
        md(i) = data(i, mm - 1)
    Next i
    GetMonthDatesList = md
End Function
'---------------------------------------------------------------------------------------
' Procedure : GetGestationalWeeks
' Author    : Plus One Software
' Date      : 2018/04/27
' Purpose   :
' Return    : Integer
'---------------------------------------------------------------------------------------
'
Public Function GetGestationalWeeks(vDate As Date, Optional aDate As Date) As Integer
    aDate = setDate(aDate)
    Dim w As Integer
    w = WorksheetFunction.RoundDown(DiffDays(vDate, aDate) / 7, 0)
    If w < 0 Then
        Call Err.Raise(54889, , "????")
        Exit Function
    ElseIf w > 45 Then
        Call Err.Raise(889, , "母体に負担が大きすぎます。すぐに病院へ。")
        Exit Function
    End If
    GetGestationalWeeks = w
End Function
'---------------------------------------------------------------------------------------
' Procedure : getCsvFromWeb
' Author    : Plus One Software
' Date      : 2018/04/27
' Purpose   : ネット上のCSVデータを文字列として取得する
' Return    : String:全文一括の文字列
'---------------------------------------------------------------------------------------
'
Private Function getCsvFromWeb(url As String) As String
    Dim HTTP As Object
    Dim res As String
    Set HTTP = CreateObject("MSXML2.XMLHTTP")
    HTTP.Open "GET", url, False     'false:同期通信 すべての応答が返ってから次へ
    HTTP.Send   '実際に要求を送信
    If HTTP.Status = 200 Then   'エラーページが返ってくるので常に200
        res = HTTP.responseText
    End If
    Set HTTP = Nothing
    getCsvFromWeb = res
End Function
'---------------------------------------------------------------------------------------
' Procedure : setDate
' Author    : Plus One Software
' Date      : 2018/04/27
' Purpose   :
' Return    : Date
'---------------------------------------------------------------------------------------
'
Private Function setDate(d As Date) As Date
    If d = "0:00:00" Then
        d = Date
    End If
    setDate = d
End Function

DateCalculatorClass 使い方

組み込み

クラス(ユーザー定義型)ですので、VBEでクラスモジュールを追加してから、上記のコードをバシッとコピーペーストしてください。

あとは標準モジュールの中で使うのもよし、フォームモジュールの中で使うのもよし。お好きにやって下さいまし。

インスタンス化

通常のクラスとしてインスタンス化してあげてください。

書式

Dim 変数名 As クラスオブジェクト名
Set 変数名 = New クラスオブジェクト名

 

コード例

Dim cal As DateCalculatorClass
Set cal = New DateCalculatorClass

使い方

後述する機能から使いたいものを選んで適所に用います。

プロパティは取得のみ可能。引数については、取るもの、取らないもの、省略可能なものなどあります。詳細は後述の説明を参照してください。

書式

変数(インスタンス)名.プロパティ(引数1, 引数2, 引数3, 引数4)

変数(インスタンス)名.関数(引数1, 引数2, 引数3)

コード例

    Dim cal As DateCalculatorClass
    Set cal = New DateCalculatorClass
    ' 2000年2月1日を含む月(2000年2月のこと)のカレンダーを作成する
    Dim data
    data = cal.GetCalendar("2000/2/1")
    Range("A1:G7") = data
    ' 2008年8月8日の曜日を、日本語の省略形の括弧付きで求める
    Debug.Print cal.Weekday(aDay:="2008/8/8", withBrackets:=True, fullString:=False, withEnglish:=False)
    ' 1991年8月11日生まれの人の、2006年12月13日付の年齢を求める
    Debug.Print cal.HowOld(birthday:="1991/8/11", aDate:="2006/12/13")
    ' 2018年2月8日を起算日として、2018年6月27日時点での妊娠週数を求める
    Debug.Print cal.GetGestationalWeeks("2018/2/8", "2018/6/27")
    Set cal = Nothing

実行結果

インスタンスの破棄

通常通りです。

書式

Set 変数名 = Nothing

コード例

    Set cal = Nothing

DateCalculatorClass のプロパティ

このクラスのプロパティはすべて取得のみ可能です。設定することはできません。

Today:今日の日付

現在の日付を今日の日付として返します。

書式

日付型変数 = 変数(インスタンス)名.Today

コード例

    '今日の日付
    Debug.Print "今日", cal.Today

Yesterday:昨日の日付

昨日の日付を返します。

書式

日付型変数 = 変数(インスタンス)名.Yesterday( [aDay] )

  • 引数 aDay:昨日を求める基準となる日付。日付型。省略した場合は今日の日付を基準とする。

コード例

    '昨日の日付
    Debug.Print "昨日", cal.Yesterday
    Debug.Print "2010/10/8 の昨日", cal.Yesterday("2010/10/8")

Tomorrow:明日の日付

明日の日付を返します。

書式

日付型変数 = 変数(インスタンス)名.Tomorrow( [aDay] )

  • 引数 aDay:明日を求める基準となる日付。日付型。省略した場合は今日の日付を基準とする。

コード例

    '明日の日付
    Debug.Print "明日", cal.Tomorrow
    Debug.Print "2010/10/8 の明日", cal.Tomorrow("2010/10/8")

Weekday:曜日

指定された日付が何曜日であるかを返します。

書式

文字列型変数 = 変数(インスタンス)名.Weekday( [aDay, withBrackets, fullString, withEnglish] )

  • 引数 aDay:曜日を求める日付。日付型。省略した場合は今日に設定される。
  • 引数 withBrackets:括弧付きにするかどうか。真偽値。省略した場合は False。
  • 引数 fullString:省略しない曜日名を返すかどうか。真偽値。省略した場合は False。
  • 引数 withEnglish:英語の曜日名で返すかどうか。真偽値。省略した場合は False。

コード例

    ' 2008年8月8日の曜日を、日本語の省略形の括弧付きで求める
    Debug.Print "今日の曜日", cal.Weekday()
    Debug.Print "2008/8/8 の曜日", cal.Weekday(aDay:="2008/8/8", withBrackets:=True, fullString:=False, withEnglish:=False)
    Debug.Print "2008/8/8 の曜日", cal.Weekday("2008/8/8", , True)
    Debug.Print "2008/8/8 の曜日", cal.Weekday("2008/8/8", , , True)
    Debug.Print "2008/8/8 の曜日", cal.Weekday(aDay:="2008/8/8", fullString:=True, withEnglish:=True)

DaysAfter:xx日後

指定された日付のxx日後の日付を返します。

書式

整数型変数 = 変数(インスタンス)名.DaysAfter( [aDay] )

  • 引数 aDay:基準となる日付。日付型。省略した場合は今日の日付を基準とする。

コード例

    Debug.Print "今日から30日後", cal.DaysAfter(30)
    Debug.Print "2018/4/5 から12日後", cal.DaysAfter(12, "2018/4/5")

DaysBefore:xx日前

指定された日付のxx日前の日付を返します

書式

整数型変数 = 変数(インスタンス)名.DaysBefore( [aDay] )

  • 引数 aDay:基準となる日付。日付型。省略した場合は今日の日付を基準とする。

コード例

    'X日前
    Debug.Print "今日から30日前", cal.DaysBefore(30)
    Debug.Print "2018/4/5 から12日前", cal.DaysBefore(12, "2018/4/5")

DiffYears:2つの日付間の年差

指定された2つの日付間の年差を返します。

書式

整数型変数 = 変数(インスタンス)名.DiffYears( d1[, d2] )

  • 引数 d1:求める先または前の日付。日付型。必須。
  • 引数 d2:基準とする日付。日付型。省略した場合は今日を基準とする。

コード例

    '年差
    Debug.Print "2015/11/3 と今日の年差", cal.DiffYears("2015/11/3")
    Debug.Print "2010/1/1 と 2018/4/5 の年差", cal.DiffYears("2010/1/1", "2018/4/5")

DiffMonths:2つの日付間の月差

指定された2つの日付間の月差を返します。

書式

整数型変数 = 変数(インスタンス)名.DiffMonths( d1[, d2] )

  • 引数 d1:求める先または前の日付。日付型。必須。
  • 引数 d2:基準とする日付。日付型。省略した場合は今日を基準とする。

コード例

    '月差
    Debug.Print "2017/11/3 と今日の月差", cal.DiffMonths("2017/11/3")
    Debug.Print "2017/1/1 と 2018/4/5 の月差", cal.DiffMonths("2017/1/1", "2018/4/5")

DiffWeeks:2つの日付間の週差

指定された2つの日付間の週差を返します。

書式

整数型変数 = 変数(インスタンス)名.DiffWeeks( d1[, d2] )

  • 引数 d1:求める先または前の日付。日付型。必須。
  • 引数 d2:基準とする日付。日付型。省略した場合は今日を基準とする。

コード例

    '週差
    Debug.Print "2018/1/3 と今日の週差", cal.DiffWeeks("2018/1/3")
    Debug.Print "1978/11/1 と 1980/4/5 の週差", cal.DiffWeeks("1978/11/1", "1980/4/5")

DiffDays:2つの日付間の日差

指定された2つの日付間の日差を返します。

書式

整数型変数 = 変数(インスタンス)名.DiffDays( d1[, d2] )

  • 引数 d1:求める先または前の日付。日付型。必須。
  • 引数 d2:基準とする日付。日付型。省略した場合は今日を基準とする。

コード例

    '日差
    Debug.Print "2018/1/1 と今日の日差", cal.DiffDays("2018/1/1")
    Debug.Print "2018/1/1 と 2018/4/5 の日差", cal.DiffDays("2018/1/1", "2018/4/5")

EOMonth:月末の日付

月末の日付を返します。

書式

日付型変数 = 変数(インスタンス)名.EOMonth( [aDay, months] )

  • 引数 aDay:基準となる日付。日付型。省略した場合は今日を基準とする。
  • 引数 months:基準日から加算する月数。整数型。正の数でxxヶ月後の月末、負の数でxxヶ月前の月末日付を求めることが可能。省略した場合は0。

コード例

    '月末の日付
    Debug.Print "今日を含む月(今月)の月末", cal.EOMonth()
    Debug.Print "2014/9/4 を含む月の月末", cal.EOMonth("2014/9/4")
    Debug.Print "2014/9/4 から6か月後の月末", cal.EOMonth("2014/9/4", 6)

DateCalculatorClass の関数

日付やカレンダー関連の便利なデータを簡単に得ることができます。

HowOld:年齢を取得する

誕生日を考慮した年齢を返します。

書式

変数(インスタンス)名.HowOld( birthday[, aDate] )

  • 引数 birthday:誕生日を指定します。日付型。必須。
  • 引数 aDate:年齢を計算する日付を指定します。日付型。省略した場合は今日。

返値

整数型:Integer

誕生日を考慮するので、例えば引数birthdayに1990年5月1日を指定し、引数aDateに2010年4月30日を指定した場合は「19」、2010年5月1日を指定した場合は「20」が返されます。

コード例

    ' 1991年8月11日生まれの人の、2006年12月13日付の年齢を求める
    Debug.Print "1991年8月11日生まれの人の今の年齢", cal.HowOld("1991/8/11")
    Debug.Print "1991年8月11日生まれの人の、2006年12月13日付の年齢", cal.HowOld(birthday:="1991/8/11", aDate:="2006/12/13")

IsHoliday:祝日であるか

指定された日付が祝日であるかどうか。祝日であれば祝日名を返します。

書式

変数(インスタンス)名.IsHoliday( d )

  • 引数 d:日付型。必須。

返値

バリアント型:Variant

バリアント型の値を返します。
祝日であれば「こどもの日」などの祝日名を、祝日でなければ「False」のブール値を返します。

コード例

    '祝日であるか
    Debug.Print "2018/8/11 が祝日かどうか", cal.IsHoliday("2018/8/11")
    Debug.Print "2018/7/5 が祝日かどうか", cal.IsHoliday("2018/7/5")

GetHolidayList:祝日一覧を取得する

去年、今年、来年の3ヶ年分の祝日一覧を返します。

祝日のデータは「https://holidays-jp.github.io/api/v1/date.csv」より取得しています。インターネット接続環境が必要です。

書式

変数(インスタンス)名.GetHolidayList( )

返値

バリアント型:Variant

「祝日の日付 , 祝日名」という形式のバリアント型二次元配列を返します。

コード例

    '祝日リスト(去年、今年、来年分)
    ' https://holidays-jp.github.io/api/v1/date.csv より取得
    Dim data1
    data1 = cal.GetHolidayList()
    Sheets(1).Range("A1:B" & UBound(data1) + 1) = data1

GetCalendar:カレンダーを取得する

指定された日付を含む月のカレンダーを返します。

書式

変数(インスタンス)名.GetCalendar( [d , shortName] )

  • 引数 d:作成したい年月を含む日付(日は何日でも良い)を指定します。日付型。省略した場合は今月のカレンダーを返す。
  • 引数 shortName:曜日名を短い形式にするか、長い形式にするかの指定です。真偽値。省略するとTrue(短い曜日形式)

返値

バリアント型:Variant

7行7列のバリアント型の二次元配列を返します。

コード例

    ' 2000年2月1日を含む月(2000年2月のこと)のカレンダーを作成する
    Dim data2
    data2 = cal.GetCalendar("2000/2/1")
    With Sheets(2).Range("A1:G7")
        .NumberFormatLocal = "d"
        .Value = data2
    End With
    data2 = cal.GetCalendar("2001/2/1", True)
    With Sheets(2).Range("I1:O7")
        .NumberFormatLocal = "d"
        .Value = data2
    End With

GetDatesOfFixedDay:月内の特定曜日の日付を取得する

指定された年月の指定された曜日の日付をすべて返します。例えば、「2018年9月のすべての土曜日の日付」を取得することができます。

書式

変数(インスタンス)名.GetDatesOfFixedDay( wd[, yr, mm] )

  • 引数 wd:求める曜日、日曜〜土曜を1〜7の番号で指定します。整数型。必須。
  • 引数 yr:対象となる年を指定します。整数型。省略した場合は今年。
  • 引数 mm:対象となる月を指定します。整数型。省略した場合は今月。

返値

バリアント型:Variant

日付が格納された一次元配列を返します。

コード例

    '月内の特定曜日の日付リスト(2016年12月の日曜日のリスト)
    Dim data3
    data3 = cal.GetDatesOfFixedDay(1, 2016, 12)
    Debug.Print "2016年12月の日曜日のリスト"
    Dim i
    For i = LBound(data3) To UBound(data3)
        Debug.Print data3(i),
    Next i
    Debug.Print

GetDatesOfFixedWeek:第x週の日付をすべて取得する

指定された番号の週の日付をすべて返します。

書式

変数(インスタンス)名.GetDatesOfFixedWeek(weekNum[,yr, mm] )

  • 引数 weekNum:週番号を指定します。整数型。必須。
  • 引数 yr:対象となる年を指定します。整数型。省略した場合は今年。
  • 引数 mm:対象となる月を指定します。整数型。省略した場合は今月。

返値

バリアント型:Variant

日付が格納された一次元配列を返します。

コード例

    '月内の特定週の日付リスト(2016年12月の第2週のリスト)
    Dim data5
    data5 = cal.GetDatesOfFixedWeek(2, 2016, 12)
    Debug.Print "2016年12月の第2週のリスト"
    For i = LBound(data5) To UBound(data5)
        Debug.Print data5(i),
    Next i
    Debug.Print

GetAnnualDateList:年間のすべての日付リストを取得する

指定された年のすべての日付を返します。

書式

変数(インスタンス)名.GetAnnualDateList(yr [, direction] )

  • 引数 yr:年を指定します。整数型。必須。
  • 引数 direction:縦長のリスト(月を横に、日付を縦に並べる)にするか、横長のリスト(月を縦に、日付を横に並べる)にするかを、xlVertical、xlHorizontalのエクセル組み込み定数で指定します。省略するとxlVertical。

返値

バリアント型:Variant

バリアント型の二次元配列を返します。

コード例

    '指定年のすべての日付リスト(2018年のリストを縦方向と横方向で)
    Dim data4
    data4 = cal.GetAnnualDateList(2018)
    Sheets(3).Range("A1:L" & UBound(data4) + 1) = data4
    Erase data4
    data4 = cal.GetAnnualDateList(2018, xlHorizontal)
    Sheets(4).Range("A1:AE" & UBound(data4) + 1) = data4

GetMonthDatesList:月の日付リストを取得する

指定された年月の日付のリストを返します。

書式

変数(インスタンス)名.GetMonthDatesList( [yr, mm] )

  • 引数 yr:対象となる年を指定します。整数型。省略した場合は今年。
  • 引数 mm:対象となる月を指定します。整数型。省略した場合は今月。

返値

バリアント型:Variant

日付が格納された一次元配列を返します。

コード例

    '指定月の日付リスト(2011年2月のリスト)
    Dim data6
    data6 = cal.GetMonthDatesList(2011, 2)
    Debug.Print "今月の日付リスト"
    For i = LBound(data6) To UBound(data6)
        Debug.Print data6(i),
    Next i
    Debug.Print

GetGestationalWeeks:妊娠週数を取得する

指定された日付間の妊娠週数を返します。

書式

変数(インスタンス)名.GetGestationalWeeks(vDate[, aDate] )

  • 引数 vDate:起算日を指定します。日付型。必須。
  • 引き数 aDate:週数を求める日付を指定します。日付型。省略すると今日。

返値

整数型:Integer

整数型の値を返します。

コード例

    ' 妊娠週数を求める
    Debug.Print "2018年2月8日を起算日とした2018年6月27日時点での妊娠週数", cal.GetGestationalWeeks("2018/2/8", "2018/6/27")

コメントを残す

メールアドレスが公開されることはありません。

日本語が含まれない投稿、および宣伝に類する投稿は無視されますのでご注意ください。(スパム対策)