[[20170729224829]] 『マクロを実行すると日にちと曜日を指定日数分出す』(狭山) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『マクロを実行すると日にちと曜日を指定日数分出すマクロ』(狭山)

お世話になります。
またよろしくお願いいたします。

以下のような作業をマクロで行えればとても効率よく行えるので
書かせていただきました。

マクロを実行するとMsgBoxが出てきて
”始まりの年月日を入力して下さい”
2017/12/23
と入力して次のMsgBoxは
”終わりの年月日を入力して下さい”
2018/1/9
と入力すると下記のように出すことは可能でしょうか。
条件は
A列
:年度またぎはA2とA12のように年度が入る
:C列が(土)(日)の場合はA列に休祝が入る
:祝日はP3:P50に年月日 Q3:Q50に祝日名を入力しておきますので参照
B列
:年月日
C列
:曜日を( )で表示

	A	B	C	D	P        	Q
1	年	月日	曜日			
2	平成29年				2017年1月1日	元日
3	祝	12月23日	(土)	天皇誕生日	2017年1月2日	振替休日
4	休	12月24日	(日)		2017年1月9日	成人の日
5		12月25日	(月)		2017年2月11日	建国記念の日
6		12月26日	(火)		2017年3月20日	春分の日
7		12月27日	(水)		2017年4月29日	昭和の日
8		12月28日	(木)		2017年5月3日	憲法記念日
9		12月29日	(金)		2017年5月4日	みどりの日
10	休	12月30日	(土)		2017年5月5日	こどもの日
11	休	12月31日	(日)		2017年7月17日	海の日
12	平成30年				2017年8月11日	山の日
13	祝	1月1日	(月)	元日	2017年9月18日	敬老の日
14		1月2日	(火)		2017年9月23日	秋分の日
15		1月3日	(水)		2017年10月9日	体育の日
16		1月4日	(木)		2017年11月3日	文化の日
17		1月5日	(金)		2017年11月23日	勤労感謝の日
18	休	1月6日	(土)		2017年12月23日	天皇誕生日
19	休	1月7日	(日)		2018年1月1日	元日
20	祝	1月8日	(月)	成人の日	2018年1月8日	成人の日
21		1月9日	(火)		2018年2月11日	建国記念の日

どうぞよろしくご教授ください。

< 使用 Excel:Excel2013、使用 OS:Windows7 >


 こういうことでしょうか?
 エラー処理していないので、年月日の入力間違いに注意してください。

    Sub お茶()
        Dim sDate As Date
        Dim eDate As Date
        sDate = Application.InputBox("はじめの年月日を入力してください。(YYYY/MM/DD)")
        eDate = Application.InputBox("終わりの年月日を入力してください。(YYYY/MM/DD)")

        Dim v As Variant
        ReDim v(1 To 4, 1 To DateValue(eDate) - DateValue(sDate) + 1)

        Dim cnt As Long
        cnt = 1

        Dim d As Long
        For d = DateValue(sDate) To DateValue(eDate)
            Debug.Print cnt
            If cnt = 1 Or Format(d - 1, "ggge年") <> Format(d, "ggge年") Then
                v(1, cnt) = Format(d, "ggge年")
                cnt = cnt + 1
                ReDim Preserve v(1 To 4, 1 To UBound(v, 2) + 1)
            End If
            v(4, cnt) = evaluate("IFERROR(VLOOKUP(" & d & ",E:F,2,false),"""")")
            v(1, cnt) = IIf(InStr(1, "土日", Format(d, "aaa")) > 0, "休", "")
            v(1, cnt) = IIf(v(4, cnt) <> "", "祝", v(1, cnt))
            v(2, cnt) = d
            v(3, cnt) = Format(d, "(aaa)")
            cnt = cnt + 1
        Next d
        Range("A2").Resize(UBound(v, 2), UBound(v, 1)).Value = Application.Transpose(v)
    End Sub

(稲葉) 2017/07/30(日) 08:55


早速にありがとうございました。
実際に、2017/12/20〜2018/1/30を実行してみましたが
いくつか問題が出てしまいました。
私の説明不足で申し訳ございません。

2017/12/23日ですが(土)と祝日がダブってしまいますので
これを休・祝 という表示にしたいのです。
他にも(日)もダブル場合も同じに。

D列ですが説明をいれるのを忘れてしまいました。申し訳ございません。
Q列の祝日名を転記したいのですが
2017/12/23日ですと D列に 天皇誕生日 と表示です。

また、(土)(日)祝の列は全てフォントの色を赤にしたいのです。
説明不足と作業の追加、本当に申し訳ございませんが
どうぞよろしくお願いいたします。

(狭山) 2017/07/30(日) 10:24


 これから出掛けてしまうので、しばらく返事できません
 急ぎでしたら、別の回答者をお待ちください
 D列はすでに入力されていると思いますが、いかがてすか?

 >また、(土)(日)祝の列は全てフォントの色を赤にしたいのです。 
 列ではなく、行ですよね
 こちらは条件付き書式を試してください
(稲葉) 2017/07/30(日) 11:06

 お忙しい中、ありがとうございました。
 D列はすでに入力されていると思いますが、いかがてすか?
 ですがマクロを実行してもD列は空白になってしまいます。

 また、(土)(日)祝の列は全てフォントの色を赤にしたいのです。 
 列ではなく、行ですよね
 はい、申し訳ございません。
 行でした。

 私もこれから外出してしまいますので帰宅後
 条件付き書式を検索し行ってみたいと思います。
 質問ですが、マクロではフォントの色は出来ないのでしょうか。
 何も分からずでお恥ずかしいです。

(狭山) 2017/07/30(日) 12:18


 早速行ってみました。
 2つの条件付き書式を入れてみましたが変化なく
 =WEEKDAY($B:$B,1)=7
 =WEEKDAY($B:$B,1)=1
 ご教授をお願いいたします。
(狭山) 2017/07/30(日) 17:51

 >v(4, cnt) = evaluate("IFERROR(VLOOKUP(" & d & ",E:F,2,false),"""")")
 のE:FをP:Qに変更

 >v(1, cnt) = IIf(v(4, cnt) <> "", "祝", v(1, cnt))
 ここを
 v(1, cnt) = v(1, cnt) & IIf(v(4, cnt) <> "", "祝", "")
 こちらに差し替え

 A:Dを選択して、条件付き書式
 =OR(LEFT($A1)="休",LEFT($A1)="祝")

 でいかがですか?
(稲葉) 2017/07/30(日) 19:42

 (稲葉)様、完璧です。
 本当に有難うございました。
 最初におっしゃってた
 エラー処理していないので、年月日の入力間違いに注意してください。
 の意味が分かりました。
 日にちをオーバーした時に実行エラーが出るのですね。
 気を付けて入力いたします。
 以下に完了の式を残させていただきます。

    Sub お茶()
    Dim sDate As Date
    Dim eDate As Date
    sDate = Application.InputBox("はじめの年月日を入力してください。(YYYY/MM/DD)")
    eDate = Application.InputBox("終わりの年月日を入力してください。(YYYY/MM/DD)")

    Dim v As Variant
    ReDim v(1 To 4, 1 To DateValue(eDate) - DateValue(sDate) + 1)

    Dim cnt As Long
    cnt = 1

    Dim d As Long
    For d = DateValue(sDate) To DateValue(eDate)
        Debug.Print cnt
        If cnt = 1 Or Format(d - 1, "ggge年") <> Format(d, "ggge年") Then
            v(1, cnt) = Format(d, "ggge年")
            cnt = cnt + 1
            ReDim Preserve v(1 To 4, 1 To UBound(v, 2) + 1)
        End If
        v(4, cnt) = Evaluate("IFERROR(VLOOKUP(" & d & ",P:Q,2,false),"""")")
        v(1, cnt) = IIf(InStr(1, "土日", Format(d, "aaa")) > 0, "休", "")
        v(1, cnt) = v(1, cnt) & IIf(v(4, cnt) <> "", "祝", "")
        v(2, cnt) = d
        v(3, cnt) = Format(d, "(aaa)")
        cnt = cnt + 1
    Next d
    Range("A2").Resize(UBound(v, 2), UBound(v, 1)).Value = Application.Transpose(v)
End Sub

 有難うございました。
(狭山) 2017/07/30(日) 21:18

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.