ＶＢＡ 日付の期間を表示する方法

質問

以前は仕事と話しましたが、勉強が仕事みたいでした；
すみません。また質問させてください。
ＶＢＡで日付をやる際Format(Date, "ggge年m月d日")というようなソースを書くと思うのですが、今回知りたいのが入力フォームというブックに日付をセットすると予め用意されている別のブックの表にそのセットした日付から１ヶ月間分の日付と曜日を行に貼り付けていきたいのですがどうしたらいいのでしょうか？

日付を一年前までの日付かどうかのチェックのソースもよろしくおねがいします。

その入力フォームのマクロはまだ、値チェックまでしかできていません。

意味不明かもしれませんが何卒よろしくお願いします。

------------ソース------------------

Option Explicit

Private Sub CommandButton1_Click()

If Worksheets("日付セット").Range("C6") = "" Then '値が入っているか
MsgBox ("日付を入力してください！")
Exit Sub
Else
End If
End Sub

回答No.1

pkh4989 · ベストアンサー

'こんにちは。
'参考にしてください。
'2つのブックを開いた状態で試してみてください。
'日付は「2008/10/16」のように入力してくださいね。

Sub CommandButton1_Click()
　　Dim wStr　　　　As String
　　Dim wDate　　　 As String
　　Dim wDate2　　　As String
　　Dim Exitflg　　 As Boolean
　　Dim wI　　　　　As Integer
　　Dim wVal　　　　As Variant
　　Dim wSh1　　　　As Worksheet
　　Dim wSh2　　　　As Worksheet
　　'
　　Set wSh1 = Workbooks("Book1.xls").Worksheets("日付セット")　'←実際のブック名とシート名に変更
　　Set wSh2 = Workbooks("Book2.xls").Worksheets("Sheet1")　　　'←実際のブック名とシート名に変更
　　'
　　If wSh1("日付セット").Range("C6") = "" Then　　 '値が入っているか
　　　　MsgBox "日付を入力してください！"
　　　　Exit Sub
　　Else
　　　　wDate = wSh1.Cells(6, "C")　　　　　'←入力日付
　　　　If DateAdd("yyyy", -1, wDate) > wDate Then
　　　　　　'１年前の日付より少ない場合
　　　　　　MsgBox "日付を正しく入力してください！"
　　　　　　Exit Sub
　　　　End If
　　End If
　　'
　　wVal = Array("日", "月", "火", "水", "木", "金", "土")
　　wDate = wSh1.Cells(6, "C")　　　　　'←入力日付
　　wDate2 = DateAdd("m", 1, wDate)　　 '←入力日付より１ヶ月
　　wI = 0
　　Exitflg = False
　　'入力日付より１ヶ月分の日付と曜日を表示
　　Do While Exitflg = False
　　　　wStr = DateAdd("d", wI, wDate)
　　　　If wStr = wDate2 Then
　　　　　　Exitflg = True
　　　　Else
　　　　　　'日付設定
　　　　　　wSh2.Cells(wI + 1, 2) = wStr
　　　　　　'曜日設定
　　　　　　wSh2.Cells(wI + 1, 3) = wVal(Weekday(wStr) - 1)
　　　　End If
　　　　wI = wI + 1
　　Loop
End Sub

補足

早速の回答ありがとうございます。

参考にやらせていただきます！

私の説明不足だったかもしれませんが、曜日は日付の下に表示させたいんですが可能ですか？

　　Ａ　　Ｂ　　Ｃ
４　日付　日付　日付
５　曜日　曜日　曜日

とういう形にしたいのですが・・・

再びよろしくお願いします。

言葉足りずで説明べたですみません

回答No.9

pkh4989

仕様がそうなっているでしょう？
今日～未来日付(1年後まで) OK

違う？
過去(今日から1年前)～今日まで
ならば、以下のように変更

　　wDate = Replace(wSh1.Cells(6, "C"), "西暦", "") '←西暦を取る
　　wDate = Format(wSh1.Cells(6, "C"), "yyyy/mm/dd")
　　If Date < wDate Then
　　　　MsgBox "未来の日付入力はできません！"
　　　　Exit Sub
　　End If
　　If DateAdd("yyyy", -1, Date) > wDate Then
　　　　MsgBox "日付を正しく過去１年以内で日付を設定してください！"
　　　　Exit Sub
　　End

お礼

タイトルが違うかもしれないので一旦閉めます。

本やインターネットみてちょっと探ってみてそれでも解らない場合はまたよろしくお願いします。

補足

言葉足らずですみません…
過去(今日から1年前)～今日まで のことを言いたかったんです。

日付できました！！

表作成なんですけど
３１日分の表（罫線も引いてあります）ができているんですが、
月によって３１日だったり３０日だったりすると思うんですが、それにあわせて罫線も随時直していきたいのですが無理なのでしょうか？

２日間にわたり本当にありがとうございます

回答No.8

pkh4989

wSh1.Cells(6, "C") = TextBox1.Text　　'←実際のテキストボックス名称に変更
↓
wSh1.Cells(6, "C") = "2008/11/1" '←直接日付を入れてテストしてみてください。
これでOKなら、テキストボックス入力データ設定に問題があると思います。

補足

やはり未来日付だと表に表示されました。
１年の期間に入っているところで過去の日付で設定できませんになります。

何がちがうのでしょうか・・・

ソース載せたほうがいいですか？

回答No.7

pkh4989

Book1がActiveになっていないからですね。
もう１回以下のマクロを全て入替えて、試してみてください。
　　wDate = Replace(Cells(6, "C"), "西暦", "") '←西暦を取る
　　wDate = Format(Cells(6, "C"), "yyyy/mm/dd")
　　↓
　　wDate = Replace(wSh1.Cells(6, "C"), "西暦", "") '←西暦を取る
　　wDate = Format(wSh1.Cells(6, "C"), "yyyy/mm/dd")

Private Sub CommandButton1_Click()
　　Dim wStr　　　　As String
　　Dim wDate　　　 As String
　　Dim wDate2　　　As String
　　Dim Exitflg　　 As Boolean
　　Dim wI　　　　　As Integer
　　Dim wVal　　　　As Variant
　　Dim wSh1　　　　As Worksheet
　　Dim wSh2　　　　As Worksheet
　　'
　　Set wSh1 = Workbooks("Book1.xls").Worksheets("日付セット")　'←実際のブック名とシート名に変更
　　Set wSh2 = Workbooks("Book2.xls").Worksheets("Sheet1")　　　'←実際のブック名とシート名に変更
　　'
　　'UserFormのテキストボックスよりシートのセル(6,"C")へ設定する
　　wSh1.Cells(6, "C") = TextBox1.Text　　'←実際のテキストボックス名称に変更
　　'
　　If wSh1.Range("C6") = "" Then　　 '値が入っているか
　　　　MsgBox "日付を入力してください！"
　　　　Exit Sub
　　End If
　　wDate = Replace(wSh1.Cells(6, "C"), "西暦", "") '←西暦を取る
　　wDate = Format(wSh1.Cells(6, "C"), "yyyy/mm/dd")
　　If Date > wDate Then
　　　　MsgBox "過去の日付入力はできません！"
　　　　Exit Sub
　　End If
　　If DateAdd("yyyy", 1, Date) < wDate Then
　　　　MsgBox "日付を正しく１年以内で日付を設定してください！"
　　　　Exit Sub
　　End If
　　'
　　wVal = Array("日", "月", "火", "水", "木", "金", "土")
　　wDate = wSh1.Cells(6, "C")　　　　　'←入力日付
　　wDate2 = DateAdd("m", 1, wDate)　　 '←入力日付より１ヶ月
　　wI = 0
　　Exitflg = False
　　'入力日付より１ヶ月分の日付と曜日を表示
　　Do While Exitflg = False
　　　　wStr = DateAdd("d", wI, wDate)
　　　　If wStr = wDate2 Then
　　　　　　Exitflg = True
　　　　Else
　　　　　　'日付設定
　　　　　　wSh2.Cells(wI + 1, 2) = Format(wStr, "mm/dd")　　　 '月/日
　　　　　　'曜日設定
　　　　　　wSh2.Cells(wI + 1, 3) = wVal(Weekday(wStr) - 1)
　　　　End If
　　　　wI = wI + 1
　　Loop
End Sub

補足

やはり日付をチェックするところで表までたどりつきません・・・
どうしたらいいのでしょうか？
未来日付でも表に日付を表示してしまったり、１年以内でも過去の日付は入力できませんって出てしまいます。

回答No.6

pkh4989

以下のように追加・変更してください。

<一つ目>
If wSh1("日付セット").Range("C6") = "" Then '日付が入力されているか
　↓
If wSh1.Range("C6") = "" Then '日付が入力されているか

<2 つ目>
★過去の日付が入力された場合、エラー
★未来の日付「1年を超える」の場合、エラ－
例えば、今日「2008/10/17」より以前の日付「2008/10/16」の時
　　　　　　　　　　　　1年を超える日付「2009/10/18」の時

wDate = Replace(Cells(6, "C"), "西暦", "") '←西暦を取る
wDate = Format(Cells(6, "C"), "yyyy/mm/dd")
If Date > wDate Then
　　MsgBox "過去の日付入力はできません！"
　　Exit Sub
End If
If DateAdd("yyyy", 1, Date) < wDate Then　
　　MsgBox "日付を正しく１年以内で日付を設定してください！"
　　Exit Sub
End If

補足

ありがとうございます。
ただ、これだと表に表示されないんです・・・
１年以内でも過去の日付入力はできませんとなってしまいますし・・・

あと表に枠線が引いてあって入力するとあまるったり足りなかったりすると思うんですがそれも設定するということは可能なんでしょうか？

インターネットとか見てもよくわからなくて・・・

再びよろしくお願いします

回答No.5

pkh4989

wVal = Array("日", "月", "火", "水", "木", "金", "土")
　　wDate = wSh1.Cells(6, "C")　　　　　'←入力日付
　　wDate2 = DateAdd("m", 1, wDate)　　 '←入力日付より１ヶ月
　　wI = 0 '←必ず「0」ではないと行けない
　　Exitflg = False
　　'入力日付より１ヶ月分の日付と曜日を表示
　　Do While Exitflg = False
　　　　wStr = DateAdd("d", wI, wDate) '← １日づつ加算するのでここは最初に「1」ではないと駄目です。
　　　　If wStr = wDate2 Then
　　　　　　Exitflg = True
　　　　Else
　　　　　　'日付設定
　　　　　　wSh2.Cells(4, wI + 11) = Format(wStr, "mm/dd")　　 '←ここを修正すれば良いですよ(するか、別の変数を使うか)
　　　　　　'曜日設定
　　　　　　wSh2.Cells(5, wI + 11) = wVal(Weekday(wStr) - 1)
　　　　End If
　　　　wI = wI + 1
　　Loop

補足

またまたありがとうございます！

２つの質問で解決すると思うんですがよろしくお願いします。

一つ目

『オブジェクトはこのプロパティまたはメソッドをサポートしていません』と出てしまいます・・・。
なぜなんでしょうか？

If wSh1("日付セット").Range("C6") = "" Then '日付が入力されているか
MsgBox ("日付を入力してください！")
Exit Sub
Else
wDate = wSh1.Cells(6, "C") '入力日付
If DateAdd("yyyy", -1, wDate) > wDate Then '１年以前の日付を少ない場合
MsgBox "日付を正しく入力してください！"
Exit Sub
Else
'wDate = Format(Cells(6, "C"), "yyyy/mm/dd") '未来日付が入力された場合
If Date > wDate Then
MsgBox "１年以内で日付を設定してください！"
Exit Sub
End If
End If
End If

２つ目
wDate = Replace(Cells(6, "C"), "西暦", "") '←西暦を取る
wDate = Format(Cells(6, "C"), "yyyy/mm/dd") '未来日付が入力された場合
If Date > wDate Then
MsgBox "１年以内で日付を設定してください！"
Exit Sub
End If
メッセージボックスであらわすはずが日付が表示してしまいます・・・

お忙しいとは思いますがよろしくお願いします。

回答No.4

pkh4989

UserFormのテキストボックスより入力日付をシート上へ設定及び日付展開
Book1,Book2のシートを全て文字列に設定してから、試してみてください。
「2008/10/1」 として日付を入力すると、セル(6,"C")上に「2008/10/1」と設定されると思います。
「西暦2008/10/1」と入力する必要はないと思いますが、もし入力しても変換して展開しますので問題はないと思います。
展開日付も「月/日」の形式で展開されます。
後、細かい部分等は、自分で勉強しながら追加・修正してみてください。
新たに分からない時、まだ質問してくださいね。

Private Sub CommandButton1_Click()
　　Dim wStr　　　　As String
　　Dim wDate　　　 As String
　　Dim wDate2　　　As String
　　Dim Exitflg　　 As Boolean
　　Dim wI　　　　　As Integer
　　Dim wVal　　　　As Variant
　　Dim wSh1　　　　As Worksheet
　　Dim wSh2　　　　As Worksheet
　　'

　　Set wSh1 = Workbooks("Book1.xls").Worksheets("日付セット")　'←実際のブック名とシート名に変更
　　Set wSh2 = Workbooks("Book2.xls").Worksheets("Sheet1")　　　'←実際のブック名とシート名に変更
　　'
　　'UserFormのテキストボックスよりシートのセル(6,"C")へ設定する
　　wSh1.Cells(6, "C") = TextBox1.Text　　'←実際のテキストボックス名称に変更
　　'
　　If wSh1.Range("C6") = "" Then　　 '値が入っているか
　　　　MsgBox "日付を入力してください！"
　　　　Exit Sub
　　Else
　　　　wDate = Replace(Cells(6, "C"), "西暦", "")　　　　　'←西暦を取る
　　　　wDate = Format(Cells(6, "C"), "yyyy/mm/dd")　　　　 '←入力日付
　　　　If Date > wDate Then
　　　　　　MsgBox "日付を正しく入力してください！"
　　　　　　Exit Sub
　　　　End If
　　End If
　　'
　　wVal = Array("日", "月", "火", "水", "木", "金", "土")
　　wDate = wSh1.Cells(6, "C")　　　　　'←入力日付
　　wDate2 = DateAdd("m", 1, wDate)　　 '←入力日付より１ヶ月
　　wI = 0
　　Exitflg = False
　　'入力日付より１ヶ月分の日付と曜日を表示
　　Do While Exitflg = False
　　　　wStr = DateAdd("d", wI, wDate)
　　　　If wStr = wDate2 Then
　　　　　　Exitflg = True
　　　　Else
　　　　　　'日付設定
　　　　　　wSh2.Cells(wI + 1, 2) = Format(wStr, "mm/dd")　　　 '月/日
　　　　　　'曜日設定
　　　　　　wSh2.Cells(wI + 1, 3) = wVal(Weekday(wStr) - 1)
　　　　End If
　　　　wI = wI + 1
　　Loop
End Sub

補足

ありがとうございます。
今まで自分で調べてわからないとほっておいたので新しいこと覚えている分楽しく勉強してます。

wVal = Array("日", "月", "火", "水", "木", "金", "土")
　　wDate = wSh1.Cells(6, "C")　　　　　'←入力日付
　　wDate2 = DateAdd("m", 1, wDate)　　 '←入力日付より１ヶ月
　　wI = 11
　　Exitflg = False
　　'入力日付より１ヶ月分の日付と曜日を表示
　　Do While Exitflg = False
　　　　wStr = DateAdd("d", wI, wDate)
　　　　If wStr = wDate2 Then
　　　　　　Exitflg = True
　　　　Else
　　　　　　'日付設定
　　　　　　wSh2.Cells(4,wI + 1) = Format(wStr, "mm/dd")　　　 '月/日
　　　　　　'曜日設定
　　　　　　wSh2.Cells(5,wI + 1) = wVal(Weekday(wStr) - 1)
　　　　End If
　　　　wI = wI + 1
　　Loop

このときに表示されるのが11日後の日付から表示されてしまうのですが・・・なにが違うのでしょうか？

表はＬ４から日付が行に入り、Ｌ５から曜日が行に入っていくという表になっています。

よろしくお願いします。

回答No.3

pkh4989

以下のように変更してください。

>未来日付を入力した場合のエラー表示
>あと日付を入れるときに西暦年/月/日/を入力フォームで入力したあと
>貼り付けるブックのところに西暦も入ってしまうのですがどうしたらいいのでしょうか？
→西暦2008/09/16 のように設定されるとしたら
　Replace 関数を使って「西暦」を取ってから設定するか、セル上の「西暦」を以下のように取ってください。

wDate = Replace(Cells(6, "C"), "西暦", "")　　　　　'←西暦を取る
wDate = Format(Cells(6, "C"), "yyyy/mm/dd")　　　　 '←入力日付
　　　　If Date > wDate Then
　　　　　　MsgBox "日付を正しく入力してください！"
　　　　　　Exit Sub
　　　　End If
End Sub

補足

お返事遅くなりました。

本当に申し訳ないのですが・・・

日付を別ブックに表示させるところがうまくいきません…

wVal = Array("日", "月", "火", "水", "木", "金", "土")
　　wDate = wSh1.Cells(6, "C")　　　　　'←入力日付
　　wDate2 = DateAdd("m", 1, wDate)　　 '←入力日付より１ヶ月
　　wI = 0
　　Exitflg = False
　　'入力日付より１ヶ月分の日付と曜日を表示
　　Do While Exitflg = False
　　　　wStr = DateAdd("d", wI, wDate)
　　　　If wStr = wDate2 Then
　　　　　　Exitflg = True
　　　　Else
　　　　　　'日付設定
　　　　　　wSh2.Cells(4,wI + 1) = wStr
　　　　　　'曜日設定
　　　　　　wSh2.Cells(5,wI + 1) = wVal(Weekday(wStr) - 1)
　　　　End If
　　　　wI = wI + 1
　　Loop

たとえば2007/2/1に入力すると
2/12日から表示されてしまいます…

それともうひとつなんですが、日付を張り付けるときに入力したやつの１か月間で年を入れずに月/日のみにしたいのですがどうしたらいいのでしょうか？

勉強不足で申し訳ありません…

よろしくお願いします。

回答No.2

pkh4989

以下の部分を変更すればいいですよ。

　'wSh2.Cells(wI + 1, 2) = wStr
　'wSh2.Cells(wI + 1, 3) = wVal(Weekday(wStr) - 1)
　↓
　'日付設定
　wSh2.Cells(4, wI + 1) = wStr
　'曜日設定
　wSh2.Cells(5, wI + 1) = wVal(Weekday(wStr) - 1)

補足

ありがとうございます！！

できました。

また質問なんですけど

日付のところで質問なんですが、もし、未来日付を入力した場合のエラー表示は

wDate = wSh1.Cells(6, "C")　　　　　'←入力日付
　　　　If DateAdd("yyyy", 1, wDate) > wDate Then
　　　　　　MsgBox "日付を正しく入力してください！"
　　　　　　Exit Sub
これでいいのでしょうか？

あと日付を入れるときに西暦年/月/日/を入力フォームで入力したあと
貼り付けるブックのところに西暦も入ってしまうのですがどうしたらいいのでしょうか？

初心者過ぎて申し訳ございません。