[今週・先週・来週の日付を取得(期間)]
今週・先週・来週の期間を取得するマクロです。1〜13の足し算と引き算で取得できます。
[今週] 基準日の曜日から、今週の「月曜日」、今週の「日曜日」を計算する。
[先週] 基準日の曜日から、先週の「月曜日」、先週の「日曜日」を計算する。
[来週] 基準日の曜日から、来週の「月曜日」、来週の「日曜日」を計算する。
Sub dThisWeek()
'今週の期間を取得
Dim sToday As
String
Dim dToday As Date
'dToday = Date '基準日
dToday =
"2008/09/10" '基準日
sToday = Format(dToday, "aaa") '基準日を曜日に変換
MsgBox
"基準日 --> " & dToday
Select Case sToday
Case
"月"
MsgBox "今週 -- >" & dToday & " 〜" & dToday +
6
Case "火"
MsgBox "今週 -- >" & dToday - 1 & " 〜" &
dToday + 5
Case "水"
MsgBox "今週 -- >" & dToday - 2 & " 〜"
& dToday + 4
Case "木"
MsgBox "今週 -- >" & dToday - 3 &
" 〜" & dToday + 3
Case "金"
MsgBox "今週 -- >" & dToday - 4
& " 〜" & dToday + 2
Case "土"
MsgBox "今週 -- >" &
dToday - 5 & " 〜" & dToday + 1
Case "日"
MsgBox "今週 -- >"
& dToday - 6 & " 〜" & dToday + 0
End
Select
End Sub
Sub dLastWeek()
'先週の期間を取得
Dim sToday As
String
Dim dToday As Date
'dToday = Date '基準日
dToday =
"2008/09/10" '基準日
sToday = Format(dToday, "aaa") '基準日を曜日に変換
MsgBox
"基準日 --> " & dToday
Select Case sToday
Case
"月"
MsgBox "先週 -- >" & dToday - 7 & " 〜" & dToday -
1
Case "火"
MsgBox "先週 -- >" & dToday - 8 & " 〜" &
dToday - 2
Case "水"
MsgBox "先週 -- >" & dToday - 9 & " 〜"
& dToday - 3
Case "木"
MsgBox "先週 -- >" & dToday - 10
& " 〜" & dToday - 4
Case "金"
MsgBox "先週 -- >" &
dToday - 11 & " 〜" & dToday - 5
Case "土"
MsgBox "先週 -- >"
& dToday - 12 & " 〜" & dToday - 6
Case "日"
MsgBox "先週 --
>" & dToday - 13 & " 〜" & dToday - 7
End
Select
End Sub
Sub dNextWeek()
'来週の期間を取得
Dim sToday As
String
Dim dToday As Date
'dToday = Date '基準日
dToday =
"2008/09/10" '基準日
sToday = Format(dToday, "aaa") '基準日を曜日に変換
MsgBox
"基準日 --> " & dToday
Select Case sToday
Case
"月"
MsgBox "来週 -- >" & dToday + 7 & " 〜" & dToday +
13
Case "火"
MsgBox "来週 -- >" & dToday + 6 & " 〜" &
dToday + 12
Case "水"
MsgBox "来週 -- >" & dToday + 5 & " 〜"
& dToday + 11
Case "木"
MsgBox "来週 -- >" & dToday + 4
& " 〜" & dToday + 10
Case "金"
MsgBox "来週 -- >" &
dToday + 3 & " 〜" & dToday + 9
Case "土"
MsgBox "来週 -- >"
& dToday + 2 & " 〜" & dToday + 8
Case "日"
MsgBox "来週 --
>" & dToday + 1 & " 〜" & dToday + 7
End
Select
End Sub
|