Skip to content

Instantly share code, notes, and snippets.

@furyutei
Last active Dec 23, 2021
Embed
What would you like to do?
[Excel][VBA] 日付操作用クラスモジュールを試作

[Excel][VBA] 日付操作用クラスモジュールを試作

ちゅん@KotorinChunChunさんの作られていたものが便利そうだったので、参考にしつつ自分でも試作してみました(ただし互換性はありません)。

サンプルのダウンロード

下の画像をダウンロードして拡張子を「*.zip」に変更後に解凍すると、サンプルのマクロ有効ワークシート(日付を操作するクラス.xlsm)が現れます。

日付を操作するクラス 20211223 002

VBEを開いて(Alt+F11)DateExtExampleを実行するとイミディエイトウィンドウに結果が表示されます。
DateExtExample 001

ソースコード

元ネタ

VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "DateExt"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Option Explicit
Private ThisDateTime As Date
Property Get FmtDefault(): FmtDefault = "Long Date": End Property
Property Get FmtDate(): FmtDate = "yyyy/mm/dd": End Property
Property Get FmtDateWeekDay(): FmtDateWeekDay = "yyyy/mm/dd(aaa)": End Property
Property Get FmtTime(): FmtTime = "hh:nn:ss": End Property
Property Get FmtDateTime(): FmtDateTime = "yyyy/mm/dd hh:nn:ss": End Property
Property Get FmtYYYYMMDD(): FmtYYYYMMDD = "yyyymmdd": End Property
Property Get FmtGEEMMDD(): FmtGEEMMDD = "geemmdd": End Property
Property Get FmtSqlYMDHMS(): FmtSqlYMDHMS = "\#yyyy-mm-dd hh:nn:ss\#": End Property
Property Get FmtSqlYMD(): FmtSqlYMD = "\#yyyy-mm-dd\#": End Property
Property Get StrDefault(): StrDefault = Me.Format(FmtDefault): End Property
Property Get StrDate(): StrDate = Me.Format(FmtDate): End Property
Property Get StrDateWeekDay(): StrDateWeekDay = Me.Format(FmtDateWeekDay): End Property
Property Get StrTime(): StrTime = Me.Format(FmtTime): End Property
Property Get StrDateTime(): StrDateTime = Me.Format(FmtDateTime): End Property
Property Get StrYYYYMMDD(): StrYYYYMMDD = Me.Format(FmtYYYYMMDD): End Property
Property Get StrGEEMMDD(): StrGEEMMDD = Me.Format(FmtGEEMMDD): End Property
Property Get StrSqlYMDHMS(): StrSqlYMDHMS = Me.Format(FmtSqlYMDHMS): End Property
Property Get StrSqlYMD(): StrSqlYMD = Me.Format(FmtSqlYMD): End Property
Private Sub Class_Initialize()
ThisDateTime = Now()
End Sub
Function Create(Optional NewDateTime) As DateExt
If IsMissing(NewDateTime) Then NewDateTime = VBA.DateValue(Now())
Dim NewDateTimeExt As DateExt: Set NewDateTimeExt = New DateExt
Call NewDateTimeExt.SetDateTime(NewDateTime)
Set Create = NewDateTimeExt
End Function
Function Clone() As DateExt
Set Clone = Create(Me)
End Function
Function SetDateTime(Optional NewDateTime) As DateExt
If IsMissing(NewDateTime) Then NewDateTime = VBA.DateValue(Now())
ThisDateTime = CDate(NewDateTime)
Set SetDateTime = Me
End Function
Function SetDateTimeSerial(Optional Year, Optional Month, Optional Day, Optional Hour, Optional Minute, Optional Second) As DateExt
If IsMissing(Year) Then Year = Me.Year
If IsMissing(Month) Then Month = Me.Month
If IsMissing(Day) Then Day = Me.Day
If IsMissing(Hour) Then Hour = Me.Hour
If IsMissing(Minute) Then Minute = Me.Minute
If IsMissing(Second) Then Second = Me.Second
ThisDateTime = VBA.DateSerial(CInt(Year), CInt(Month), CInt(Day)) + VBA.TimeSerial(CInt(Hour), CInt(Minute), CInt(Second))
Set SetDateTimeSerial = Me
End Function
Function SetDateSerial(Year, Month, Day) As DateExt
Set SetDateSerial = SetDateTime(VBA.DateSerial(CInt(Year), CInt(Month), CInt(Day)))
End Function
Function SetTimeSerial(Hour, Minute, Second) As DateExt
Set SetTimeSerial = SetDateTime(VBA.TimeSerial(CInt(Hour), CInt(Minute), CInt(Second)))
End Function
Property Get Value() ' [Default Property]
Attribute Value.VB_UserMemId = 0
Value = Me.DateTime
End Property
Property Let Value(SpecifiedValue): Me.DateTime = SpecifiedValue: End Property
Property Get DateTime(): DateTime = ThisDateTime: End Property
Property Let DateTime(SpecifiedDateTime): ThisDateTime = CDate(SpecifiedDateTime): End Property
Property Get DateValue() As Date: DateValue = VBA.DateValue(ThisDateTime): End Property
Property Get TimeValue() As Date: TimeValue = VBA.TimeValue(ThisDateTime): End Property
Property Get Year() As Long: Year = VBA.Year(ThisDateTime): End Property
Property Let Year(SpecifiedYear As Long): Call SetDateTimeSerial(Year:=SpecifiedYear): End Property
Property Get Month() As Long: Month = VBA.Month(ThisDateTime): End Property
Property Let Month(SpecifiedMonth As Long): Call SetDateTimeSerial(Month:=SpecifiedMonth): End Property
Property Get Day() As Long: Day = VBA.Day(ThisDateTime): End Property
Property Let Day(SpecifiedDay As Long): Call SetDateTimeSerial(Day:=SpecifiedDay): End Property
Property Get Hour() As Long: Hour = VBA.Hour(ThisDateTime): End Property
Property Let Hour(SpecifiedHour As Long): Call SetDateTimeSerial(Hour:=SpecifiedHour): End Property
Property Get Minute() As Long: Minute = VBA.Minute(ThisDateTime): End Property
Property Let Minute(SpecifiedMinute As Long): Call SetDateTimeSerial(Minute:=SpecifiedMinute): End Property
Property Get Second() As Long: Second = VBA.Second(ThisDateTime): End Property
Property Let Second(SpecifiedSecond As Long): Call SetDateTimeSerial(Second:=SpecifiedSecond): End Property
Property Get Weekday(Optional FirstDayOfWeek As VbDayOfWeek = vbSunday) As Long
Weekday = VBA.Weekday(ThisDateTime, FirstDayOfWeek)
End Property
Property Get WeekdayName(Optional Abbreviate As Boolean = False)
WeekdayName = VBA.WeekdayName(VBA.Weekday(ThisDateTime), Abbreviate)
End Property
Property Get ToString(Optional SpecifiedFormat)
ToString = Me.Format(SpecifiedFormat)
End Property
Property Get Format(Optional SpecifiedFormat)
If IsMissing(SpecifiedFormat) Then SpecifiedFormat = FmtDefault
Format = VBA.Format(ThisDateTime, SpecifiedFormat)
End Property
Property Get ShiftYear(Optional YearOffset As Long = 0, Optional AdjustDate As Boolean = True) As DateExt
Set ShiftYear = ShiftMonth(12 * YearOffset, AdjustDate)
End Property
Property Get ShiftMonth(Optional MonthOffset As Long = 0, Optional AdjustDate As Boolean = True) As DateExt
Dim NewDateTime As Date: NewDateTime = VBA.DateSerial(VBA.Year(ThisDateTime), VBA.Month(ThisDateTime) + MonthOffset, VBA.Day(ThisDateTime))
If AdjustDate Then
Dim MonthEndDate As Date: MonthEndDate = VBA.DateSerial(VBA.Year(ThisDateTime), VBA.Month(ThisDateTime) + MonthOffset + 1, 0)
If MonthEndDate < NewDateTime Then NewDateTime = MonthEndDate
End If
Set ShiftMonth = Create(NewDateTime)
End Property
Property Get ShiftWeek(Optional WeekOffset As Long = 0) As DateExt
Set ShiftWeek = ShiftDay(7 * WeekOffset)
End Property
Property Get ShiftDay(Optional DayOffset As Long = 0) As DateExt
Set ShiftDay = Create(DateAdd("d", DayOffset, ThisDateTime))
End Property
Property Get YearBegin() As DateExt
Set YearBegin = Create(VBA.DateSerial(VBA.Year(ThisDateTime), 1, 1))
End Property
Property Get YearEnd() As DateExt
Set YearEnd = Create(VBA.DateSerial(VBA.Year(ThisDateTime) + 1, 1, 0))
End Property
Property Get FiscalYearBegin(Optional FirstMonthOfFiscalYear = 4) As DateExt
Dim NewDateTime As Date: NewDateTime = VBA.DateSerial(VBA.Year(ThisDateTime), FirstMonthOfFiscalYear, 1)
If ThisDateTime < NewDateTime Then NewDateTime = DateAdd("yyyy", -1, NewDateTime)
Set FiscalYearBegin = Create(NewDateTime)
End Property
Property Get FiscalYearEnd(Optional FirstMonthOfFiscalYear = 4) As DateExt
Set FiscalYearEnd = FiscalYearBegin(FirstMonthOfFiscalYear).ShiftYear(1).ShiftDay(-1)
End Property
Property Get MonthBegin() As DateExt
Set MonthBegin = Create(VBA.DateSerial(VBA.Year(ThisDateTime), VBA.Month(ThisDateTime), 1))
End Property
Property Get MonthEnd() As DateExt
Set MonthEnd = Create(VBA.DateSerial(VBA.Year(ThisDateTime), VBA.Month(ThisDateTime) + 1, 0))
End Property
Property Get WeekBegin(Optional FirstDayOfWeek As VbDayOfWeek = vbMonday) As DateExt
Set WeekBegin = ShiftDay(1 - VBA.Weekday(ThisDateTime, FirstDayOfWeek))
End Property
Property Get WeekEnd(Optional FirstDayOfWeek As VbDayOfWeek = vbMonday) As DateExt
Set WeekEnd = ShiftDay(7 - VBA.Weekday(ThisDateTime, FirstDayOfWeek))
End Property
Option Explicit
Sub DateExtExample()
Dim dt As DateExt: Set dt = DateExt.Create(Now())
Debug.Print "今 "; dt, "日付 "; dt.DateValue, "時刻 "; dt.TimeValue, "日時 "; dt.DateTime
Debug.Print "※個別", dt.Year, dt.Month, dt.Day, dt.Weekday, dt.Hour, dt.Minute, dt.Second, dt.WeekdayName, dt.WeekdayName(True)
Debug.Print "表示形式", dt.StrDefault, dt.StrDate, dt.StrDateTime, dt.StrYYYYMMDD, dt.StrGEEMMDD, dt.StrSqlYMD, dt.StrSqlYMDHMS
Debug.Print "※任意", dt.Format("dddd, mmm d yyyy hh:mm:ss AM/PM")
Debug.Print "※時分秒を0に", dt.SetDateTimeSerial(, , , 0, 0, 0).StrDateTime
Debug.Print "今週(月曜はじまり)", dt.WeekBegin; " ~ "; dt.WeekEnd
Debug.Print "今週(日曜はじまり)", dt.WeekBegin(vbSunday); " ~ "; dt.WeekEnd(vbSunday)
Debug.Print "今月", dt.MonthBegin; " ~ "; dt.MonthEnd
Debug.Print "今年", dt.YearBegin; " ~ "; dt.YearEnd
Debug.Print "今年度", dt.FiscalYearBegin; " ~ "; dt.FiscalYearEnd
Debug.Print "2日後", dt.ShiftDay(2)
Debug.Print "1月後の月初", dt.ShiftMonth(1).MonthBegin
Debug.Print "2年2ヶ月後の月末", dt.ShiftYear(2).ShiftMonth(2).MonthEnd
Debug.Print "元日の年度",: With dt.YearBegin: Debug.Print .FiscalYearBegin; " ~ "; .FiscalYearEnd: End With
Debug.Print "3/31の年度",: With dt.Clone().SetDateTimeSerial(Month:=3, Day:=31): Debug.Print .FiscalYearBegin; " ~ "; .FiscalYearEnd: End With
Debug.Print "4/1の年度",: With dt.Clone().SetDateTimeSerial(Month:=4, Day:=1): Debug.Print .FiscalYearBegin; " ~ "; .FiscalYearEnd: End With
Debug.Print "今年度(9月はじまり)", dt.FiscalYearBegin(9), dt.FiscalYearEnd(9)
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment