こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

VBA スケジュール表作成_連想配列で祝日設定

Win10でExcelは2016を使用しています。
「西暦」をMsgBoxで指定し、スケジュール表を作成するマクロを作成中です。
日曜と祝日のセルをグレー&赤文字にさせたいので、別シートに祝日を表にしそれを連想配列に記憶させて、祝日も赤文字にさせたいのですが、下記のマクロですと祝日の曜日のセルをグレー&赤文字に出来ず行き詰っています。
------
Sub スケジュール_日_祝_休ver()

Dim ws1 As Worksheet
Dim myDic As Object
Dim buf As String
Dim i As Integer
Dim Keys() As Variant

Dim ws2 As Worksheet 'シート
Dim ye As Integer '年
Dim mo As Integer '月
Dim dy As Integer '日
Dim dLast As Integer '最終日
Dim r As Integer '日付書き込み列


Set myDic = CreateObject("Scripting.Dictionary")
Set ws1 = Worksheets("祝日")
maxRow = ws1.Range("C65536").End(xlUp).Row

For i = 2 To maxRow
buf = ws1.Cells(i, 3).Value 'C列のセルの値をbufに格納する
If buf = "" Then '空白セルではなく
ElseIf Not myDic.Exists(buf) Then '辞書にまだ登録されていなければ
myDic.Add buf, 1 'そのセルの値を連想配列に登録する。
End If

Next i

ye = Application.InputBox("西暦を入れて下さい", Type:=1)

Set ws2 = Worksheets("白紙")

With ws2
r = 2

'当年1~12月
'1日の列に月を表示
For mo = 1 To 12
If mo = 1 Then
.Cells(1, r) = "’" & ye & "年" & mo & "月"
.Cells(1, r).Font.Bold = True
.Cells(1, r).Font.Name = "HGP創英角ゴシックUB"
.Cells(1, r).Font.Size = 20

Else
.Cells(1, r) = mo & "月"
.Cells(1, r).Font.Bold = True
.Cells(1, r).Font.Name = "HGP創英角ゴシックUB"
.Cells(1, r).Font.Size = 20
End If

'最終日取得
dLast = Day(DateSerial(ye, mo + 1, 0))

'日にちと曜日を入れ、日・祝 のセルをグレー&赤文字
For dy = 1 To dLast

.Cells(3, r) = ye & "/" & mo & "/" & dy
.Cells(3, r).NumberFormatLocal = "d"

.Cells(4, r) = WeekdayName(Weekday(.Cells(3, r).Value), True)

Key = .Cells(3, r).Value

If .Cells(4, r).Value = "日" Or .Cells(3, r).Value = myDic.Item(Key) Then '日と祝日
.Cells(4, r).Font.ColorIndex = 3
ws2.Range(Cells(5, r), Cells(73, r)).Select
With Selection.Interior
.ColorIndex = 15
End With
End If

r = r + 1

Next dy

'月変わりに縦太線を引く
.Range(Cells(1, r - 1), Cells(73, r - 1)).Select
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With

Next mo

End With

End Sub
-------
原因をさぐるべくF8で確認しながら進めたところ、
「If .Cells(4, r).Value = "日" Or .Cells(3, r).Value = myDic.Item(Key) Then 」
のところで、.Cells(3, r).Value は「2020/1/1/」でmyDic.Item(Key)は「2020/01/01/」になっていました。
やはり、これですと同じとは認識されないのでしょうか?
でも、月日が2ケタの祝日のセルをグレー&赤文字にならず、他の原因のような気もします...
--
どなたかご教示頂けましたら有難いです。
よろしくお願い致します。

投稿日時 - 2019-11-13 11:37:09

QNo.9678430

困ってます

質問者が選んだベストアンサー

bufを日付として格納してください。
ElseIf Not myDic.Exists(CDate(buf)) Then '辞書にまだ登録されていなければ
myDic.Add CDate(buf), CDate(buf) 'そのセルの値を連想配列に登録する。

投稿日時 - 2019-11-13 13:19:31

補足

CD関数の事知らなかったので、自分メモとして、下記残させて頂きます。
すみません!

CDate 関数は、指定した値を日付型 (Date) に変換。
文字列を日付型に変換したいときに使用。
CDate(値)
値を日付型 (Date) に変換。
引数「値」文字列や数値を指定します。
戻り値の型日付型 (Date)

投稿日時 - 2019-11-13 14:03:21

お礼

kkkkkm様
ご回答ありがとうございます。
ご回答の通りに変更しましたら、希望通りになりました!
マクロの完成に向けて頑張ります。
ありがとうございました。

投稿日時 - 2019-11-13 13:59:14

ANo.2

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(4)

ANo.4

> object.Add key, item  ’←ここに追加?
> myDic.Add CDate(buf), CDate(buf) 'その

ごめんなさい説明不足でした。
Add メソッド (Dictionary オブジェクト)の構文が
object.Add key, itemなので
コードでは
myDic.Add CDate(buf), CDate(buf)
となります。
という事で、コードは最初の回答のままでお願いします。


あと、質問と関係ないところなのでまたもや蛇足なのですが
maxRowとKeyの変数宣言がありませんでした。
ツール→オプションで変数宣言を強制する
にしておいた方がいいかもしれません。
https://www.239-programing.com/excel-vba/basic/basic032.html

投稿日時 - 2019-11-13 14:45:35

お礼

kkkkkm様
ご回答ありがとうございます。
そうだったんですね、承知致しました。

多々抜けているところを見直して頂いてありがとうございます。
変数宣言と強制宣言の設定を変えます。
必要なことを沢山押教えて下さりありがとうございました。

投稿日時 - 2019-11-13 15:25:37

ANo.3

No2の蛇足です。
myDic.Item(Key)
keyをもとにItemを取り出しますので今回の場合Itemは同じものを指定してください。
object.Add key, item
myDic.Add CDate(buf), CDate(buf) '

投稿日時 - 2019-11-13 13:40:41

お礼

kkkkkm様
せっかく補足頂きましたのに、理解できず申し訳ありません。
つまりこういう事ですか?
If buf = "" Then '空白セルではなく
ElseIf Not myDic.Exists(CDate(buf)) Then '辞書にまだ登録されていなければ
object.Add key, item  ’←ここに追加?
myDic.Add CDate(buf), CDate(buf) 'そのセルの値を連想配列に登録する。
End If

投稿日時 - 2019-11-13 14:09:10

ANo.1

myDic.Add buf, 1

myDic.Add Replace(buf, "/0", "/"), 1
にして下さい。

投稿日時 - 2019-11-13 12:14:11

お礼

unokwave様
ご回答頂きありがとうございます。
ご指摘のところを変更してみましたが、セルグレー赤文字にはなりませんでした。
申し訳ありません。

投稿日時 - 2019-11-13 13:16:31

あなたにオススメの質問