いつも即実用という感じのものばかり作っているので、たまにはコアな匂いのするものも書いてみようかと思いたってやってみました。
VBAで日付を扱うのはそんなに難しいことではないのだけれどなんか面倒くさいので、少しだけでもこのめんどくささが解消されればいいな、と思って書いてみました。
エラー処理など施していませんので必要に応じて修正してご利用ください。特に祝日の情報取得にインターネット接続をおこなっているのでその辺りでエラーを吐くこともあるかと思います。
コード内でクラスをインスタンス化した時に今日の日付を保持するようにしていましたが、そうするとクラスをインスタンス化してずっとそのままにしておくと、今日が昨日や一昨日になってしまうこともあるため、コードを書き直しました。
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")
コメント