Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

39072 / 76732

←次へ　｜　前へ→


	【42781】Re:週単位で１枚の依頼書をプリントアウトしたい

ハチ - 06/9/21(木) 17:40 -


	引用なし

	パスワード

　http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_800_050.html
こちらの井上さんの作成された
（いつも活用させて頂いてます。井上さんありがとうございます！）
関数"CHECKEIGYOBI"を使用させて頂いて
こんな感じでも必要な日付を取得できそうです。
時間があるときにでも試してみてください。

Option Explicit

Sub Test()

Dim Ans As String
Dim Datebuf As Date, StDay As Date, EnDay As Date
Dim Fg As Boolean
Dim Ran As Range
Dim i As Long

　　Ans = InputBox("作成する月を指定（yyyy/mm)")
　　If Ans Like "####/##" = False Then
　　　　MsgBox "yyyy/mmで指定してください": Exit Sub
　　End If
　　Cells.ClearContents
　　Set Ran = Range("A1:B1")
　　Ran = Array("開始日", "終了日")
　　i = 1: Fg = False
　　Datebuf = DateValue(Ans & "/01")
　　Do While Format(Datebuf, "yyyy/mm") Like Ans = True
　　　　If CHECKEIGYOBI(Datebuf) = 1 Then
　　　　　　If Fg = False Then
　　　　　　　　StDay = Datebuf: Fg = True
　　　　　　End If
　　　　　　EnDay = Datebuf
　　　　Else
　　　　　　If Fg = True Then
　　　　　　　　Ran.Offset(i) = Array(StDay, EnDay)
　　　　　　　　i = i + 1: Fg = False
　　　　　　End If
　　　　End If
　　　　Datebuf = Datebuf + 1
　　Loop
　　'最終週用
　　If Fg = True Then
　　　　Ran.Offset(i) = Array(StDay, EnDay)
　　End If
End Sub

1 hits

▼

【42768】週単位で１枚の依頼書をプリントアウトしたい ゆき 06/9/21(木) 11:33