Option Explicit
Dim dt1 As Date
Dim b As Boolean
Sub shCreate()
Dim lnMon As Long
Dim shTo As Worksheet
Dim lnMx As Long
Application.ScreenUpdating = False
lnMx = Worksheets("Summary").Range("A" & Worksheets("Summary").Rows.Count).End(xlUp).Row
Dim dt As Date
dt = #1/1/2009#
If lnMx > 1 Then
Worksheets("Summary").Range("A2", "E" & lnMx).ClearContents
Worksheets("Summary").Range("A2", "E" & lnMx).Interior.Pattern = xlNone
Worksheets("Summary").Range("A2", "E" & lnMx).Font.ColorIndex = 1
Worksheets("Summary").Range("A2", "E" & lnMx).Font.Bold = False
End If
shDelete
For lnMon = 1 To 12
Sheets("Summary").Copy After:=Sheets(Worksheets.Count)
Set shTo = ActiveSheet
shTo.Name = lnMon & "月"
Next
Dim c As Long
c = 1
Dim ws As Worksheet
For Each ws In Worksheets
If Right(ws.Name, 1) = "月" Then
ws.Select
dt1 = DateAdd("m", c - 1, dt)
shKousei
c = c + 1
End If
Next
Worksheets("Summary").Select
Application.ScreenUpdating = True
End Sub
Sub shDelete()
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In Worksheets
If Not ws Is Worksheets("Control") Then
If Not ws Is Worksheets("Summary") Then
ws.Delete
End If
End If
Next
Application.DisplayAlerts = True
End Sub
Sub shKousei()
Dim dt2 As Date
Dim c As Long
Dim n As Long
Dim shSummary
Set shSummary = Worksheets("Summary")
Dim shControl
Set shControl = Worksheets("control")
Dim lnSumMx
lnSumMx = shSummary.Range("A" & shSummary.Rows.Count).End(xlUp).Row - 1
dt2 = dt1
c = 0
Dim rgSummary As Range
Dim rgControl As Range
With Range("A2")
Do While Month(dt1) = Month(dt2)
.Offset(c, 0).Value = dt1
.Offset(c, 1).Value = WeekdayName(Weekday(dt1))
.Offset(c, 2).Value = #9:00:00 AM#
.Offset(c, 3).Value = #5:00:00 PM#
.Offset(c, 4).Formula = "=" & .Offset(c, 3).Address & "-" & .Offset(c, 2).Address
Holiday
For n = 0 To 4
Set rgSummary = shSummary.Range("A2").Offset(lnSumMx + c, n)
Set rgControl = shControl.Range("A1").Offset(Weekday(dt1), 0)
rgSummary.Formula = "='" & .Worksheet.Name & "'!" & .Offset(c, n).Address
With .Offset(c, n)
If b = True Then
.Interior.ColorIndex = shControl.Range("F2").Interior.ColorIndex
.Font.ColorIndex = shControl.Range("F2").Font.ColorIndex
.Font.Bold = shControl.Range("F2").Font.Bold
rgSummary.Interior.ColorIndex = shControl.Range("F2").Interior.ColorIndex
rgSummary.Font.ColorIndex = shControl.Range("F2").Font.ColorIndex
rgSummary.Font.Bold = shControl.Range("F2").Font.Bold
Else
.Interior.ColorIndex = rgControl.Interior.ColorIndex
.Font.ColorIndex = rgControl.Font.ColorIndex
rgSummary.Interior.ColorIndex = rgControl.Interior.ColorIndex
rgSummary.Font.ColorIndex = rgControl.Font.ColorIndex
End If
End With
Next
dt1 = DateAdd("d", 1, dt1)
c = c + 1
Loop
End With
End Sub
Sub Holiday()
b = False
Dim c As Long
For c = 2 To 18
If dt1 = Worksheets("Control").Range("C" & c).Value Then
b = True
End If
Next
End Sub
Option Explicit
Dim dt1 As Date
Dim n As Long ' SheetWriteにてりようするためのグローバル変数nを宣言
Dim b As Boolean
Sub SheetCreate()
Dim c As Long
Dim ws As Worksheet
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Worksheets("Summary").Select
If Range("E" & Rows.Count).End(xlUp).Row > 1 Then
With Worksheets("Summary").Range("A2", "E" & Range("E" & Rows.Count).End(xlUp).Row)
.ClearContents
.Font.Bold = False
.Interior.ColorIndex = xlNone
End With
End If
SheetDelete
n = 0
For c = 1 To 12
Sheets("Summary").Copy After:=Sheets(Worksheets.Count)
ActiveSheet.Name = c & "月"
Next
c = 1
For Each ws In Worksheets
ws.Select
If Right(ws.Name, 1) = "月" Then
dt1 = #1/1/2009#
dt1 = DateAdd("m", c - 1, dt1)
SheetWrite
c = c + 1
End If
Next
Worksheets("Summary").Select
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub SheetDelete()
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In Worksheets
If Right(ws.Name, 1) = "月" Then
ws.Delete
End If
Next
Application.DisplayAlerts = True
End Sub
Sub SheetWrite()
Dim dt2 As Date
Dim lnTate As Long
lnTate = 0
Dim wsSummary As Worksheet
Dim wsControl As Worksheet
Set wsSummary = Worksheets("Summary")
Set wsControl = Worksheets("Control")
Dim x As Long
Dim rgCtrl As Range
dt2 = dt1
With Range("A2")
Do While Month(dt1) = Month(dt2)
.Offset(lnTate, 0).Value = dt1
.Offset(lnTate, 1).Value = WeekdayName(Weekday(dt1))
.Offset(lnTate, 2).Value = #9:00:00 AM#
.Offset(lnTate, 3).Value = #5:00:00 PM#
.Offset(lnTate, 4).Formula = "=" & .Offset(lnTate, 3).Address & "-" & .Offset(lnTate, 2).Address
Holiday
For x = 0 To 4 '各シートA列~E列にどう処理が入る場合のコードをfor next構文でまとめましたが、小川先生の書き方のほうがベターでしょうか?
wsSummary.Range("A2").Offset(n, x).Formula = "='" & .Worksheet.Name & "'!" & .Offset(lnTate, x).Address
Set rgCtrl = wsControl.Range("F2")
If b = True Then
.Offset(lnTate, x).Interior.ColorIndex = rgCtrl.Interior.ColorIndex
.Offset(lnTate, x).Font.ColorIndex = rgCtrl.Font.ColorIndex
.Offset(lnTate, x).Font.Bold = True
wsSummary.Range("A2").Offset(n, x).Interior.ColorIndex = rgCtrl.Interior.ColorIndex
wsSummary.Range("A2").Offset(n, x).Font.ColorIndex = rgCtrl.Font.ColorIndex
wsSummary.Range("A2").Offset(n, x).Font.Bold = True
Else
.Offset(lnTate, x).Interior.ColorIndex = wsControl.Range("A1").Offset(Weekday(dt1), 0).Interior.ColorIndex
.Offset(lnTate, x).Font.ColorIndex = wsControl.Range("A1").Offset(Weekday(dt1), 0).Font.ColorIndex
wsSummary.Range("A2").Offset(n, x).Interior.ColorIndex = wsControl.Range("A1").Offset(Weekday(dt1), 0).Interior.ColorIndex
wsSummary.Range("A2").Offset(n, x).Font.ColorIndex = wsControl.Range("A1").Offset(Weekday(dt1), 0).Font.ColorIndex
End If
Next
n = n + 1
dt1 = DateAdd("d", 1, dt1)
lnTate = lnTate + 1
Loop
End With
End Sub
Sub Holiday()
b = False
Dim c As Long
For c = 2 To 18
If Worksheets("Control").Range("C" & c).Value = dt1 Then
b = True
End If
Next
End Sub
[3] は、くり返し構文で For 文を使うか? Do Loop を使うか?という選択にもなりますし、最終的に作成するシートの数が事前に分からない場合は「伝票作成」の課題で示したようなやり方でシートを追加することになります。 カレンダーの場合は「1月-12月のシートを作る」ということで、作成するシートの枚数は既知ですね。
Option Explicit
Dim dt1 As Date
Dim n As Long ' SheetWriteにてりようするためのグローバル変数nを宣言
Dim b As Boolean '[2-1] モジュールレベル変数はもっと機能や目的が分かりやすい名前のほうがよいです。たとえば IsHoliday As Boolean とか
Sub SheetCreate()
Dim c As Long
Dim ws As Worksheet
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Worksheets("Summary").Select
If Range("E" & Rows.Count).End(xlUp).Row > 1 Then
With Worksheets("Summary").Range("A2", "E" & Range("E" & Rows.Count).End(xlUp).Row)
.ClearContents
.Font.Bold = False
.Interior.ColorIndex = xlNone
End With
End If
SheetDelete
n = 0
For c = 1 To 12
Sheets("Summary").Copy After:=Sheets(Worksheets.Count)
ActiveSheet.Name = c & "月"
Next
c = 1
For Each ws In Worksheets
' ws.Select
If Right(ws.Name, 1) = "月" Then
ws.Select '[2-2] このコードの置き場所こちらのほうが良いかと( .select を実行する回数が2回減る)
dt1 = #1/1/2009#
dt1 = DateAdd("m", c - 1, dt1)
SheetWrite
c = c + 1
End If
Next
Worksheets("Summary").Select
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub SheetDelete()
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In Worksheets
If Right(ws.Name, 1) = "月" Then
ws.Delete
End If
Next
Application.DisplayAlerts = True
End Sub
Sub SheetWrite()
Dim dt2 As Date
Dim lnTate As Long
lnTate = 0
Dim wsSummary As Worksheet
Dim wsControl As Worksheet
Set wsSummary = Worksheets("Summary")
Set wsControl = Worksheets("Control")
Dim x As Long
Dim rgCtrl As Range
dt2 = dt1
With Range("A2")
Do While Month(dt1) = Month(dt2)
.Offset(lnTate, 0).Value = dt1
.Offset(lnTate, 1).Value = WeekdayName(Weekday(dt1))
.Offset(lnTate, 2).Value = #9:00:00 AM#
.Offset(lnTate, 3).Value = #5:00:00 PM#
.Offset(lnTate, 4).Formula = "=" & .Offset(lnTate, 3).Address & "-" & .Offset(lnTate, 2).Address
Holiday
For x = 0 To 4 '各シートA列~E列にどう処理が入る場合のコードをfor next構文でまとめましたが、小川先生の書き方のほうがベターでしょうか
'[回答] [2-3] 処理の回数が多い場合を考えてみてください。たとえば同じ行のセルが30個あり、そのすべてに装飾をする場合です。
' すると、1回のほうが30回に比べて大幅に勝りますね
wsSummary.Range("A2").Offset(n, x).Formula = "='" & .Worksheet.Name & "'!" & .Offset(lnTate, x).Address
Set rgCtrl = wsControl.Range("F2") '←この書き方、うまいですね。以下のコードの可読性が上がります。
If b = True Then
.Offset(lnTate, x).Interior.ColorIndex = rgCtrl.Interior.ColorIndex
.Offset(lnTate, x).Font.ColorIndex = rgCtrl.Font.ColorIndex
.Offset(lnTate, x).Font.Bold = True
wsSummary.Range("A2").Offset(n, x).Interior.ColorIndex = rgCtrl.Interior.ColorIndex
wsSummary.Range("A2").Offset(n, x).Font.ColorIndex = rgCtrl.Font.ColorIndex
wsSummary.Range("A2").Offset(n, x).Font.Bold = True
Else
.Offset(lnTate, x).Interior.ColorIndex = wsControl.Range("A1").Offset(Weekday(dt1), 0).Interior.ColorIndex
.Offset(lnTate, x).Font.ColorIndex = wsControl.Range("A1").Offset(Weekday(dt1), 0).Font.ColorIndex
wsSummary.Range("A2").Offset(n, x).Interior.ColorIndex = wsControl.Range("A1").Offset(Weekday(dt1), 0).Interior.ColorIndex
wsSummary.Range("A2").Offset(n, x).Font.ColorIndex = wsControl.Range("A1").Offset(Weekday(dt1), 0).Font.ColorIndex
End If
Next
n = n + 1
dt1 = DateAdd("d", 1, dt1)
lnTate = lnTate + 1
Loop
End With
End Sub
Sub Holiday()
b = False
Dim c As Long
For c = 2 To 18
If Worksheets("Control").Range("C" & c).Value = dt1 Then
b = True
End If
Next
End Sub
受講生さんの投稿
(投稿ID: 4750)
今回のセミナーまでのカレンダー作成を何も見ずに1から書き上げてみました。
サンプルコードと違う部分記述やまとめ方をしている部分もいくつかありますので添削していただけると幸いです。
小川慶一さんのコメント
(コメントID: 6633)
こんにちは。
> 今回のセミナーまでのカレンダー作成を何も見ずに1から書き上げてみました。
おお、すごいですね!
> サンプルコードと違う部分記述やまとめ方をしている部分もいくつかありますので添削していただけると幸いです。
まずは、ご自身で添削し、コメントを付記してみてください。
・あえて違う書き方をしたのはどこか
・その書き方にしたことでのメリット、デメリットはどういうものか
「自分で自分のコードを批評する」というのは、とてもよい勉強になります。
コードを書き上げたときの自分以上のスキルの自分になったつもりで、ちょっとレベルが自分より劣る人に指導するつもりでコメントしてみてください。もちろん、気になるところがあれば、今から再度リライトしてもOKです。
そのうえで、メリットデメリットがはっきりしないところ、この書き方で良いのか?と疑問に思ったところについては、ご自身の考えを書き添えたうえで意見を僕に求めてください。
その状態で再度投稿いただいたところでコメントさしあげたいと思います。
※よろしければ、上記のワークをやってみた感想もそのときにお知らせください (^^
受講生さんのコメント
(コメントID: 6639)
お世話になります。ご指示を受けて再度コードを一から書き直し、コメントを入れてみました。
(1週間たってもう一度1から書き直したのでかなりコード内容は変わってしまいましたが、こちらで確認お願いします)
小川先生のサンプルコードと比較すると、各処理を実行するサブプロシージャのタイミングの違いゆえにコード全体としては記述が異なる部分も多いですが、大まかな流れは同じかと思います。
一点明確な違いがコメントに記入しているfor next構文の処理部分かと思いますがこちらの記述はいかかでしょうか(処理負荷、可読性等の点から)
なお、小川先生の仰っていた
>・あえて違う書き方をしたのはどこか
>・その書き方にしたことでのメリット、デメリットはどういうものか
の部分に対する回答としては、あえて違う書き方をした認識はなかったのですが、記述をする際、すでにあるFor next構文でまとめれそうな個所を見つけてまとめていったら書きコードになった、といったところです。
メリットは・・・正直思い浮かばないですが、個人的には直感的にこちらの記述のほうが書きやすかったです。
デメリットは繰り返し構文による処理を多用していることによる処理数の増加でしょうか?(デメリットとしてあげられるほどのものかもわかりませんが・・・)
>※よろしければ、上記のワークをやってみた感想もそのときにお知らせください (^^
1週間前に書き上げて投稿したときは「サンプルコードと全然違うな、とりあえず添削してもらおう」という印象でしたが、今回もう一度書き上げ自分の記述とサンプルコードを見比べながら処理の違いを比較していったところ、記述は違えど変数宣言や別プロシージャに入るタイミングの差であってやっていることは変わらない、みたいな部分がほとんどでした。
(もちろんタイミング一つとっても直したほうが良い部分はあるかもしれませんが)
同じゴールであっても書き方は無数にあり、「別に違ってても良い部分」と「本質的に改善したほうが良い部分」の見極めが必要だと今回感じました。(今回のコメント部分は「本質的に改善したほうが良い部分」か否かの相談です)
すみません。長くなりましたが以下今回書き上げたコードと質問部分のコメントです。
なお、当方が気づいていないだけで「ここも改善したほうが良い」部分がありましたらそちらもご教示頂けると幸いです。
> 受講生 さん:
>
> こんにちは。
>
> > 今回のセミナーまでのカレンダー作成を何も見ずに1から書き上げてみました。
>
> おお、すごいですね!
>
> > サンプルコードと違う部分記述やまとめ方をしている部分もいくつかありますので添削していただけると幸いです。
>
> まずは、ご自身で添削し、コメントを付記してみてください。
> ・あえて違う書き方をしたのはどこか
> ・その書き方にしたことでのメリット、デメリットはどういうものか
>
> 「自分で自分のコードを批評する」というのは、とてもよい勉強になります。
> コードを書き上げたときの自分以上のスキルの自分になったつもりで、ちょっとレベルが自分より劣る人に指導するつもりでコメントしてみてください。もちろん、気になるところがあれば、今から再度リライトしてもOKです。
>
> そのうえで、メリットデメリットがはっきりしないところ、この書き方で良いのか?と疑問に思ったところについては、ご自身の考えを書き添えたうえで意見を僕に求めてください。
>
> その状態で再度投稿いただいたところでコメントさしあげたいと思います。
>
>
> ※よろしければ、上記のワークをやってみた感想もそのときにお知らせください (^^
>
>
小川慶一さんのコメント
(コメントID: 6641)
添削を返送します。
ご自身でも思われていると思いますが、処理全体のロジックはしっかりしています。
なので、細かい改善点をいくつか挙げてみたという程度です。
複数の処理方法で選択に迷う場合は、以下のような考え方をするとよいです。
[1] コードがより読みやすいのはどちらだろうか
[2] 処理の件数が増えた場合に有利なのはどちらだろうか
[3] 処理件数は事前に想定できているか/不定であるか
添削内でコメントしたのは[2]にかかる部分です。
[2-1] 変数名は、変数をよりたくさん宣言したときには可読性の高いものにしておいたほうがよい。
[2-2] ループ内での処理は少ないほうがよい
[2-3] 個別に処理すると、、件数が増えると処理が重たくなる
[3] は、くり返し構文で For 文を使うか? Do Loop を使うか?という選択にもなりますし、最終的に作成するシートの数が事前に分からない場合は「伝票作成」の課題で示したようなやり方でシートを追加することになります。
カレンダーの場合は「1月-12月のシートを作る」ということで、作成するシートの枚数は既知ですね。