職業訓練

【103期生】市民開発者養成科：難問解いてみた＠カレンダー作るやつ

by 隅田智尋

先週、とある102期の卒業生が遊びに来て「VBAで困っていることがある」と相談（？）されました。

話によると、入社学習用に宿題を出されたようで、その内容が「１年分のカレンダーを作るマクロを組まなければならない」というものでした。

「中々おもしろい宿題だな」と豪先生と自分とで意見が一致したので、現役生に向けて「課題が早く終わった人の挑戦問題」と設定したところ、数名がTeamsに投稿してくれました。ｽｺﾞｲ!!

また、その中の１人である小林さんは説明動画まで作ってくださいましたので、こちらで共有したいと思います。字幕もついていて分かりやすかったです。

「作成目的は僕の説明能力の向上なので『優しい』ご指導ご鞭撻をお待ちしております。泣いちゃうので」とのことです。

社長

自分の学習成果を発信することで、ほかの方の学習サポートをするほか、いろいろな指摘も成長課題として受け取ろうとしている姿勢が市民開発者らしいですね！

学習成果の発信は、良いことばかりだと思います。豪先生のご指摘以外にも「色々な情報が集まってくるようになる」という点でも利があるからです。

例えば、アプリ作成において「今後こういう機能を追加したい」や「この部分で困っている」など、現時点で考えていることを他者と共有すると、考えの整理に繋がったり、それに関する情報が集まってきたりします。

もちろん、最終目的地である「完璧なアプリ」を見失ってはならないのですが、その一方で、最初から完璧を求めてしまうと、必ず息苦しくなってきます。

未完の状態でも発信することに意義がある…。筆者は、そう思います。

最後に、いろんな解答が集まったので紹介したいと思います。

訓練生A

黒歴史になると思いますが言い訳せずに貼ります！うるう年には対応してない、自力でやった結果DateSerial関数使わずに終わりました。

Sub カレンダー作成()
    Dim 月 As Integer
    Dim 年 As Integer
    Dim 日 As Integer

    年 = InputBox("作成するカレンダーの年を西暦4桁で入力してください。")
    
    ActiveSheet.Name = 12 & "月"
    For 日 = 1 To 31
            Cells(日 + 1, 1).Value = 年 & "/" & 12 & "/" & 日
            Columns(1).AutoFit
    Next 日
    
    For 月 = 11 To 1 Step -1
       
             If 月 = 2 Then
                Worksheets.Add.Name = 月 & "月"
                For 日 = 1 To 28
                Cells(日 + 1, 1).Value = 年 & "/" & 月 & "/" & 日
                Cells(日 + 1, 1).NumberFormat = "yyyy年M月d日(aaa)"
                Next 日
                Columns(1).AutoFit
            
             ElseIf 月 = 4 Or 月 = 6 Or 月 = 9 Or 月 = 11 Then
                Worksheets.Add.Name = 月 & "月"
                For 日 = 1 To 30
                Cells(日 + 1, 1).Value = 年 & "/" & 月 & "/" & 日
                Cells(日 + 1, 1).NumberFormat = "yyyy年M月d日(aaa)"
                Next 日
                Columns(1).AutoFit
             Else
                Worksheets.Add.Name = 月 & "月"
                For 日 = 1 To 31
                Cells(日 + 1, 1).Value = 年 & "/" & 月 & "/" & 日
                Cells(日 + 1, 1).NumberFormat = "yyyy年M月d日(aaa)"
                Next 日
                Columns(1).AutoFit
        End If
    Next 月
End Sub
訓練生B

2022年の1年分だけですが出来ました

Sub カレンダー作成()
    Dim Y As Long
    Dim M As Long
    Dim D As Long
   
    Y = 2022
    M = 1
    D = 1
        Do
            ActiveCell.Value = DateSerial(Y, M, D)
            D = D + 1
           
            If Year(ActiveCell) = 2023 Then
                Exit Do
            End If
            ActiveCell.Offset(1).Select
        Loop
       
    ActiveCell.ClearContents
   
End Sub
訓練生C

できたで…！

Sub fromYtodate()
    Dim Y As Integer
    Dim I As Integer
 
    Application.ScreenUpdating = False
    
    Y = InputBox(年)
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = Y & "年"
   
    Do Until I = 2
     
        Range("b1") = Format(DateSerial(Val(ActiveSheet.Name), 1, 1), "m月d日")
        Range("b1").Select
   
        Do Until ActiveCell.Value = DateSerial(Val(ActiveSheet.Name), 12, 31)
   
            ActiveCell.Offset(1).Value = Format(ActiveCell.Value + 1, "m月d日")
                
                If Day(ActiveCell.Value) = 1 Then
                    ActiveCell.Offset(, -1).Value = Month(ActiveCell.Value) & "月"
                End If
                
                If Weekday(ActiveCell.Value) = vbSaturday Or Weekday(ActiveCell.Value) = vbSunday Then
                ActiveCell.Interior.Color = RGB(55, 92, 119)
                End If
                If Weekday(ActiveCell.Value) = vbSunday Then
                ActiveCell.Interior.Color = RGB(239, 69, 74)
                End If
                
            ActiveCell.Offset(1).Select

                If ActiveCell.Value = Date Then
                    Exit Sub
                End If
        Loop
   
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = Val(ActiveSheet.Name) + 1 & "年"
   
   Loop
   
    Application.ScreenUpdating = True
   
End Sub

それにしても103期、おもしろい人たちが集ったものです。私もダラダラしていてはいけませんね！

すみだともひろ

隅田智尋

PAGE TOP