| |
▼ゆき さん：
想像の部分もありますが、コードを作ってみました。
まず、祭日（振替休日）のデータを用意します。
サンプルの場合、Worksheets("seet3").Range("F16:F31")にしました。
（適宜変更してください）
年間２０日ぐらいあれば足りるとおもいますが、
多めに用意して、空白にしても構いません。
データは数値です。
1月 1日: 101
9月18日: 918
11月23日:1123
というようにして下さい。
また、月初の１週間休日は想定してません。
５月などに連休が続く場合は、日曜日も祭日として設定しておいて下さい。
年度は設定してません。「今年」を取得します。
１月分を作成する場合のみ、「来年」を取得します。
祭日データもそのつもりで設定してください。
下のコードを実行すると、変数myPrtDT()に週の開始日と終了日
（祭日をはさむ場合は、その分追加）が格納されます。
コードの最後の方でDebug.Printするようにしてます。
開始日myPrtDT(0,myLooP)、終了日myPrtDT(0,myLooP)を
適宜セルにセットして、印刷を行うと良いです。
開始日については、月初めは、第１月曜の週から始め、
終了日は、最終月曜日の週末（金曜日）まで格納するようにしてます。
例えば、2006年11月の場合、
0 開始日: 6 終了日: 10
1 開始日: 13 終了日: 17
2 開始日: 20 終了日: 22
3 開始日: 24 終了日: 24
4 開始日: 27 終了日: 31
と格納されます。
最終日は、DateSerial(2006,11,31)で2006/12/01が算出できますので、
加工して下さい。
Private Sub sub_印刷サンプル()
Dim myYear As Long '年
Dim myMonth As Long '月
Dim myDayS As Long '印刷開始日
Dim myDayE As Long '印刷終了日
Dim myDate As Date '
Dim myRange As Range '祭日、振替休日データ取得用
Dim myHoliday As Object '祭日、振替休日データ格納
Dim myLooP As Long '
Dim myPrtDT() As Long '開始日と終了日を格納
Dim myBoolW As Boolean '
Dim myBoolH As Boolean '
myMonth = 11 '11月の場合（適宜セット）
myYear = Year(Date)
'１月分作成の場合は翌年分（不要なら削除）
If myMonth = 1 Then myYear = myYear + 1
'祭日データの取得（予め準備しておくこと）
Set myHoliday = CreateObject("Scripting.Dictionary")
For Each myRange In Worksheets("seet3").Range("F16:F31")
myHoliday(myRange.Value) = True
Next
'最初の月曜日を算出（休日の場合は翌日）
myDayS = 8 - Weekday(DateSerial(myYear, myMonth, 1), 3)
Do While myHoliday(myMonth * 100 + myDayS)
myDayS = myDayS + 1
Loop
'最終日を算出（翌月の場合、３１以上になる）
myDate = DateSerial(myYear, myMonth + 1, 1)
myDayE = Day(DateAdd("d", -Weekday(myDate, 3), myDate)) + 4
'データの格納
ReDim myPrtDT(1, 0)
myPrtDT(0, 0) = myDayS
myPrtDT(1, 0) = myDayS
myBoolW = True
For myLooP = myDayS To myDayE
myDate = DateSerial(myYear, myMonth, myLooP)
myBoolH = Not (Weekday(myDate) = 1 Or Weekday(myDate) = 7 Or _
myHoliday(CLng(Format(myDate, "mmdd"))))
If myBoolW = myBoolH Then
If myBoolW Then
myPrtDT(1, UBound(myPrtDT, 2)) = myLooP
End If
Else
If Not myBoolW Then
ReDim Preserve myPrtDT(1, UBound(myPrtDT, 2) + 1)
myPrtDT(0, UBound(myPrtDT, 2)) = myLooP
myPrtDT(1, UBound(myPrtDT, 2)) = myLooP
End If
myBoolW = myBoolH
End If
Next myLooP
'印刷処理
For myLooP = LBound(myPrtDT, 2) To UBound(myPrtDT, 2)
Debug.Print myLooP, "開始日:"; myPrtDT(0, myLooP), _
"終了日:"; myPrtDT(1, myLooP)
'開始日と終了日をセットして印刷する。
'月末は３１を越える場合があるので注意
Next myLooP
Set myHoliday = Nothing
End Sub
それでは。(^･ω･^)
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 06/9/22(金) 1:49 -
