昔こんなマクロを作ったのですが、当時はまだVBAを使えるようになったばかりの頃でした。
今見てみると「これはひどい」なコードでした。簡単にバグを起こしそうな感じです。
そういうわけで基本的な機能はそのまま、コードをリファクタリングしてみました。
マクロの内容
サンプルファイルは下記のリンクからダウンロードしてください。ZIP圧縮しています。
こんな感じの年間のカレンダーがあるとします。年が変わると曜日も変わりますので全部書きかえるのはとてもめんどくさいということで自動化するマクロです。元々はトイレ掃除のチェック表用に作ったものでした。
「年間」シートの右上らへんにある「実行」ボタンを押すと、インプットボックスが出てくるので、そこに作成したい西暦を半角4桁の数字で入力します。
そしたらできあがりです。下の方に隠れて見えませんが、1～3月は翌年分です。
ついでに月間カレンダーがシート別にありまして、そっちも変わります。
VBA
Sub カレンダー作成()
Const NENKAN_SHEET_NAME As String = "年間" '年間シート名
Dim thisYear As Variant '入力された西暦
Dim firstWeekday As Integer '4月1日の曜日
Dim monthLength As Integer '1か月の日数
Dim setRow As Long '入力行
Dim setCol As Long '入力列
Dim isLeapYear As Boolean '閏年の判定
Dim monthlySheetArray As Variant '月間カレンダーのシート名を格納する配列
'月間カレンダーのシート名を配列に格納する
monthlySheetArray = Split("4月,5月,6月,7月,8月,9月,10月,11月,12月,1月,2月,3月", ",")
'年度のカレンダーを作成するか入力
thisYear = Application.InputBox("西暦を半角4桁の数字で入力してください。")
'キャンセル時の処理
If thisYear = False Then
Exit Sub
End If
'西暦以外の文字列が入力されたら処理を中止する
If IsDate(thisYear & "/4/1") = False Then
MsgBox "西暦以外の文字列が入力されました。処理を中止します。"
Exit Sub
End If
'次年度分の変数を用意
nextYear = thisYear + 1
'閏年を判定
isLeapYear = False
If nextYear Mod 400 = 0 Then
isLeapYear = True
ElseIf nextYear Mod 100 <> 0 And nextYear Mod 4 = 0 Then
isLeapYear = True
End If
'年間カレンダーの中身をリセットする
For i = 3 To 48 Step 15
Worksheets(NENKAN_SHEET_NAME).Range(Cells(i, 1), Cells(i + 11, 23)).ClearContents
Next
'月間カレンダー各シートの中身をリセットする
For i = 0 To 11
Worksheets(monthlySheetArray(i)).Range("A3:G14").ClearContents
Next i
'年を入力
With Worksheets(NENKAN_SHEET_NAME)
.Range("A1").Value = thisYear & "年"
.Range("A46").Value = nextYear & "年"
'4月1日の曜日を取得、最初に入力する列を決定
firstWeekday = Weekday(thisYear & "/04/01")
setCol = firstWeekday
'年間カレンダーを作成
For i = 1 To 46 Step 15 'm月が書かれている行
For j = 7 To 23 Step 8 '土曜日のある列
setRow = i + 2
'各月の日数を算出
Select Case .Cells(i, j).Value
Case "4月", "6月", "9月", "11月"
monthLength = 30
Case "2月"
If isLeapYear = True Then
monthLength = 29
Else
monthLength = 28
End If
Case Else
monthLength = 31
End Select
'１か月分の日付を入力
For k = 1 To monthLength
.Cells(setRow, setCol).Value = k
If setCol = j Then
setRow = setRow + 2
setCol = j - 6
Else
setCol = setCol + 1
End If
If k = monthLength Then
If j = 23 Then
setCol = setCol - 16
Else
setCol = setCol + 8
End If
End If
Next k
Next j
Next i
End With
'月間カレンダーを作成
setCol = firstWeekday
For i = 0 To 11
With Worksheets(monthlySheetArray(i))
'年を入力
If i >= 9 Then
.Range("F1").Value = nextYear & "年"
Else
.Range("F1").Value = thisYear & "年"
End If
'各月の日数を算出
Select Case i
Case 0, 2, 5, 7
monthLength = 30
Case 10
If isLeapYear = True Then
monthLength = 29
Else
monthLength = 28
End If
Case Else
monthLength = 31
End Select
setRow = 3
'各シートに1ヶ月分の日付を入力
For j = 1 To monthLength
.Cells(setRow, setCol).Value = j
If setCol = 7 Then
setRow = setRow + 2
setCol = 1
Else
setCol = setCol + 1
End If
Next j
End With
Next i
End SubSplit関数から配列を作成する
各月の月間カレンダーの処理をする際、シート名を指定しながらループをかけています。
こういう場合は配列にシート名を格納しておくと処理が楽なのですが、配列に一つずつシート名を格納するよりも、Split関数を使うと簡単です。
Dim monthlySheetArray As Variant '月間カレンダーのシート名を格納する配列
'月間カレンダーのシート名を配列に格納する
monthlySheetArray = Split("4月,5月,6月,7月,8月,9月,10月,11月,12月,1月,2月,3月", ",")
'monthlySheetArray(0): "4月"
'monthlySheetArray(1): "5月"
'monthlySheetArray(2): "6月"
'⋮
''monthlySheetArray(11): "3月"まずは配列として扱う変数名をVariant型で宣言しておきます。
Split関数は第１引数に分割する文字列、第２引数に区切る記号を指定します。これはCSVファイルの１行を分割する時に使えるテクニックです。
これで配列にした変数にインデックスを渡すとシート名を取得できるようになります。インデックスは0から始まるのでその点だけ注意です。
InputBoxの使い方
InputBoxを使うと文字列を入力する画面が表示されて、ユーザの入力により処理を決めることができます。
Excelの場合はあらかじめ指定のセルに文字列を入力させてからマクロ実行という方法も取れますが、InputBoxの方が手順がわかりやすいですし、ユーザの操作によって行列を追加・削除されて指定のセルが意図しない番地にずれてしまうということもあるので、InputBoxの方が安全ですね。
Dim thisYear As Variant '入力された西暦
'年度のカレンダーを作成するか入力
thisYear = Application.InputBox("西暦を半角4桁の数字で入力してください。")
'キャンセル時の処理
If thisYear = False Then
Exit Sub
End If
'西暦以外の文字列が入力されたら処理を中止する
If IsDate(thisYear & "/4/1") = False Then
MsgBox "西暦以外の文字列が入力されました。処理を中止します。"
Exit Sub
End IfまずInputBoxで入力された値を格納する変数はVariant型で宣言しておきます。本当はInteger型で宣言したいところなのですが、ユーザは数値以外の入力をしてくる可能性があり、Integer型だと「型が一致しません」のエラーが出てしまうので、どんな値が入ってきてもいいようにVariant型にします。
キャンセルボタンが押された場合はFalseが返されます。その場合はプロシージャを抜けて処理を中止します。
その後に西暦以外の文字列が入力された場合のエラー処理を行います。IsDate関数は文字列が日付型でない場合はFalseを返すので、「thisYear & “/4/1″」を判定して日付型になっていない場合はメッセージを表示して処理を中止します。
閏年の判定
２月の日数を出すために閏年の判定が必要です。
閏年の判定方法は意外とややこしくて、
- 4で割り切れれば閏年
- ただし、4で割り切れても100で割り切れる場合は平年
- ただし、100で割り切れても400で割り切れる場合は閏年
というルールで判定する必要があります。
Dim isLeapYear As Boolean '閏年の判定
'閏年を判定
isLeapYear = False
If nextYear Mod 400 = 0 Then
isLeapYear = True
ElseIf nextYear Mod 100 <> 0 And nextYear Mod 4 = 0 Then
isLeapYear = True
End Ifこの書き方がシンプルでいいと思います。まずは400で割り切れるかで判定し、そうでない場合は100で割り切れない且つ4で割り切れるかで判定します。
その気になれば分岐は１行で書けそうですが、１行に３条件はややこしいのでこれぐらいがいいでしょう。
コメント