More than 1 year has passed since last update.

VBA 簡単な学習時間管理ツール

Last updated at 2022-08-27Posted at 2022-08-27

学習時間管理ツールについて

なんとなくすぐできそうだったので試しに作ってみました。
スマホのアプリなどは続かなかったので自作したものならカスタマイズできるし愛着でるかなと思ったので。

動作イメージ

動作の流れ

勉強する内容をドロップダウンリストで選択
勉強開始するときに打刻開始を押す
終わるときに打刻終了を押す
マスタシートのテーブルに情報がされる
ピボットテーブルを更新
ダッシュボードのグラフに反映

コード

Option Explicit

Sub StartTime()

'テーブルの項目数を取得
Dim N As Long

With Sheets("マスタ").Range("A1").ListObject
    '最終項目を取得
    N = .ListColumns(1).Range.Count
    
    'テーブルはデフォルトで１項目分確保されているので事前に項目があるのかないのかチェック
    If .ListColumns(1).Range(N).Value = "" Then
        .ListColumns(1).Range(N).Value = Date
        .ListColumns(2).Range(N).Value = Sheets("打刻").Range("B3").Value
        .ListColumns(3).Range(N).Value = Format(Time, "hh:mm")
    Else
        '最終項目の値を空白チェック（前の打刻が完了しているかいないかをチェック）
        If .ListColumns(4).Range(N).Value <> "" Then
            '完了していたら最終項目＋１に新しく項目を作成
            .ListColumns(1).Range(N + 1).Value = Date
            .ListColumns(2).Range(N + 1).Value = Sheets("打刻").Range("B3").Value
            .ListColumns(3).Range(N + 1).Value = Format(Time, "hh:mm")
        End If
    End If
End With

Range("C12") = "打刻中"

End Sub

Sub EndTime()

'テーブルの項目数を取得
Dim N As Long

With Sheets("マスタ").Range("A1").ListObject
    '最終項目を取得
    N = .ListColumns(1).Range.Count
    '最終項目の値を空白チェック（前の打刻が完了しているかいないかをチェック）
    If .ListColumns(4).Range(N).Value = "" Then
        '空白だったら現在の時間を入れる
        .ListColumns(4).Range(N).Value = Format(Time, "hh:mm")
    End If
End With

Range("C12") = "打刻停止"

ActiveWorkbook.RefreshAll

End Sub

解説

まずは打刻開始の説明

Sub StartTime()

'テーブルの項目数を取得
Dim N As Long

With Sheets("マスタ").Range("A1").ListObject
    '最終項目を取得
    N = .ListColumns(1).Range.Count
    
    'テーブルはデフォルトで１項目分確保されているので事前に項目があるのかないのかチェック
    If .ListColumns(1).Range(N).Value = "" Then
        .ListColumns(1).Range(N).Value = Date
        .ListColumns(2).Range(N).Value = Sheets("打刻").Range("B3").Value
        .ListColumns(3).Range(N).Value = Format(Time, "hh:mm")
    Else
        '最終項目の値を空白チェック（前の打刻が完了しているかいないかをチェック）
        If .ListColumns(4).Range(N).Value <> "" Then
            '完了していたら最終項目＋１に新しく項目を作成
            .ListColumns(1).Range(N + 1).Value = Date
            .ListColumns(2).Range(N + 1).Value = Sheets("打刻").Range("B3").Value
            .ListColumns(3).Range(N + 1).Value = Format(Time, "hh:mm")
        End If
    End If
End With

Range("C12") = "打刻中"

End Sub

まず、テーブルの最終項目を取得しています。
ただ、テーブルは空でも一項目文確保されているようで、空の場合と項目が一つの場合で挙動がかぶってしまったので、一列目の一項目目が空白かどうかチェックしています。
空白なら項目数は0で空白ではないなら項目数が1なのでそこで条件分岐をさせてます。

そして最終項目の打刻が完了しているかをIF文でチェック。
打刻が完了していないのに打刻開始が押せないように。
打刻が開始できたら、
１列目に今日の日付
２列目に選択した学習内容
３列目に今の時間
を転記します。

転記が終わったら

状態の部分を打刻中に変更し、打刻開始の処理は終了。

次に打刻終了についての解説

Sub EndTime()

'テーブルの項目数を取得
Dim N As Long

With Sheets("マスタ").Range("A1").ListObject
    '最終項目を取得
    N = .ListColumns(1).Range.Count
    '最終項目の値を空白チェック（前の打刻が完了しているかいないかをチェック）
    If .ListColumns(4).Range(N).Value = "" Then
        '空白だったら現在の時間を入れる
        .ListColumns(4).Range(N).Value = Format(Time, "hh:mm")
    End If
End With

Range("C12") = "打刻停止"

ActiveWorkbook.RefreshAll

End Sub

同じく最終項目を取得後、打刻が完了しているかしていないかをチェックし、完了していなかったら現在の時刻を４列目に入れる。

入れ終わったら状態を打刻停止に変更。
ピボットテーブルは更新をしないと反映されないです。
４つあるのですべて更新で対応。

疑問

なぜか学習開始時間-学習終了時間をVBAで計算しようとしたらエラーになったのでテーブルに計算式を入れる形で学習時間を出力させました。

マスタシートについて

表示形式はシート全体に時刻をセットしておくと見やすいです。

テーブルはこのような形式で作成しています。

ダッシュボードについて

好みでピボットテーブルを作成していろんな見せ方をできればいいと思いますが、試しに作ったのでこのくらいです。
直近の目標も出しておくといいかもしれません。
ピボットテーブルは一つのピボットテーブルで作成したり、コピペしてピボットテーブルを増やしてピボットグラフを作成すると、全部のグラフが連動してしまうので、それはそれで良し悪しありますが今回はグラフの軸が学習項目の場合と日付の場合で縦棒と横棒を作っているので、連動されると実装できなくなるのですべてを切り離しています。

やり方は空白セルを選択し、Alt＋D＋Pでピポットのウィザードを出します。

レポートの種類でピポットグラフレポートを選択し、次へを押します。