【VBA】自分用勤怠メモ自動化した

背景

業務でvbaの改修、メンテナンスのために、すでにあるソースを見ながら、ロジックは把握してました。さらに把握進めるために、自分でも作ってみることに。
ちょうど自分用で使っていた自分用ツールを題材に。

ツール概要

毎日やったことを記録するメモを前から手作業で作ってた。


月ごとに作成する作業が少しめんどうだったので自動化してみることに。
作りたい月を入力して、シート作成ボタンを押すと、できる。以上

対象月を取得しシート名につける
同じシート名がすでにあるかチェック
日付をその月に変える
末日調整
土日灰色に、火木出社と入れる
エラー処理




使った関数

Set hogeSht = ThisWorkbook.Worksheets(“シート名”)
　シートオブジェクトの設定。おまじない的に必要なやつ。
For i = 1 to n
	:
Next i
　繰り返し。
hogeLast = DateSerial(Year(Range(“B2”), Month(Range(“B2”))) + 1, 0)
　日付をずらす。今回は年はそのまま、月を+1、日を0(2022/05/00に該当)と指定してるので、末日が取得される。
With hoge
	:
end With
　記述を省ける。
Columns(2).delete
　列削除。
Columns(2).ColumnWidth = 1
　列幅設定。
Columns(2).Interior.ColorIndex = 15
　列背景色設定。色の指定方法は２パターン。これは簡単な方で48色ある。RGB設定もできるらしい。
Select Case hoge
	case 1
		:
	case 2
		:
End Select
　条件分岐。
On Error GoTo hoge(ラベル)
:
hoge:
	:
　エラー発生時にラベルに飛ばす。エラー処理で使う。

実際のソース

標準モジュールにて作成

Sub createSheet()

On Error GoTo err

    '全シートコピー
    Dim formatSht, execSht As Worksheet
    Dim taisyoNengetu As String
    Set formatSht = ThisWorkbook.Worksheets("フォーマット")
    Set execSht = ThisWorkbook.Worksheets("マクロ")
    
    Dim y, m As Long
    With execSht.Range("B2")
        y = Year(.Value)
        m = Month(.Value)
    End With
    taisyoNengetu = m & "月"
    
    '同シート名のシートがすでにあるか確認
    For i = 1 To Worksheets.Count
        If Worksheets(i).Name = taisyoNengetu Then
            GoTo jyuhukuErr
        End If
    Next i
    i = 0
    formatSht.Copy before:=formatSht
    ActiveSheet.Name = taisyoNengetu
    
    '日付変える、31日月によって消す
    Dim taisyoLast, taisyoLastDay
    taisyoLast = DateSerial(Year(execSht.Range("B2")), Month(execSht.Range("B2") + 1), 0)
    taisyoLastDay = Day(taisyoLast)
    
    Dim tgtDate, iCol
    For i = 1 To taisyoLastDay
        tgtDate = DateAdd("d", i - 1, execSht.Range("B2"))
        Cells(1, i + 1) = tgtDate
        iCol = i + 1 '最終日のカラム位置をとっておく
    Next i
    i = 0
    For i = 1 To 3
        If Cells(1, iCol + 1) <> "" Then
            Columns(iCol + 1).Delete
        End If
    Next i
    
    '土日灰色、火木出社
    i = 0
    For i = 1 To taisyoLastDay
        Select Case Weekday(Cells(1, i + 1))
            Case 1, 7 '土日
                Range(Cells(2, i + 1), Cells(30, i + 1)).Clear
                With Columns(i + 1)
                    .ColumnWidth = 1
                    .Interior.ColorIndex = 15
                End With
            Case 2 '月
            
            Case 3 '火
                Cells(25, i + 1) = "出社"
            Case 5 '木
                Cells(25, i + 1) = "出社"
        End Select
    Next i
    
    Exit Sub

jyuhukuErr:
    MsgBox "対象月のシートはすでにあります。" & vbCrLf & "別の月か、シートを削除してから再実施ください。"
    Exit Sub

err:
    Dim errorMsg As String
    errorMsg = err.Description
    MsgBox errorMsg
    
End Sub

作ってて今後、改善、勉強したいなと思ったところ

変数の使い方
コメントの書き方
機能の切り出し方　今はひとつのサブルーチンのみ