Excel VBAで実現！カレンダー形式のスケジュール管理と部署別色分けの効率化

この記事では、Excel VBAを使って、カレンダー形式の表にスケジュールを反映させ、部署ごとに色分け表示を行う方法を解説します。特に、VBA初心者の方や、Excelでの業務効率化を目指す方を対象に、具体的なコード例とステップを交えて分かりやすく説明します。日々の業務でスケジュール管理に課題を感じている方、Excelのスキルアップを目指している方は、ぜひ最後までお読みください。

Excel VBAでカレンダー形式の表にスケジュールを反映させたいです。

sheet1”カレンダー”

画像のようにスピンボタンで年、月が変わります。

sheet2”予定表”

A2～日付

B2～申請番号

C2～種別(全日、半日)

D2～社員番号

E2～部署名(A、B、C、D、Eを入力規則で入れたリストから選ぶ)

F2～予定名

このようになっています。

A～Dまで入力するとDの社員番号から算出された部署名と予定名が入ります。

そのため、E列とF列はVLOOKUPから算出された値となってます。

そしてこの入力された予定をカレンダーに反映させたいです。

※「全日111 ○○営業」→C列＆D列＆” ”＆F列という形式で反映

また、既に同日に予定が入っている場合は

「既に予定があります。反映してもよろしいですか？」とMsgboxを出して

はいの場合は反映、いいえの場合は処理を中止、予定表の画面がActiveの状態になるようにします。

はいの場合は改行して入力するようにしたいのですが、そもそも行を3つくらい増やした方がいいのか…予定自体は最大同日に3つくらいしか入りません。

さらに、部署によって文字の色分けをしたいです。

ものすごい中途半端に作っているのですが、やりたいことをこまごまとつくっていったら下記のようになりました。どこを直せばいいか、何を使えばいいかご教授いただけると幸いです。

関数だけでも教えていただけると嬉しいです。

    Sub 予定をカレンダーに反映()

    Dim Maxrow, d As Long
    Dim cid As String
    Dim rc As Integer
    Dim 月日 As Day
    Dim sws, cws As Worksheet

    Set sws = Sheets("予定表")
    Set cws = Sheets("カレンダー")

    sws.Activate
    Maxrow = Cells(Rows.Count, 1).End(xlUp).Row

    d = cwc.Range("B3") & Range("D3")
    月日 = Format(d, "YYYYMM")

    Application.ScreenUpdating = False

    '|もし既に予定が入っていたらポップアップ
    For x = 5 To 15 Step 2
     For y = 2 To 8

     If cws.Cells(x, y) <> "" Then
     cid = sws.Range("C" & i) & sws.Range("D" & i)
     cwc.Cells(x, y).Offset(1) = cid & " " & sws.Range("F" & i) & vbLf
     Call .部署別色分け
     Else
     Call .重複
     End If
     Next y
    Next x
    ------------------
    Sub 重複()

     Dim rc As Integer

     rc = MsgBox("同日に既に予定があります。" & vbCrLf & "反映してよろしいですか？", _
     vbYesNo + vbQuestion, "確認")

     If rc = vbYes Then
     MsgBox "処理を行います"
     Else
     MsgBox "処理を中断します"
     End If

    End Sub
    ------------------
    Sub 部署別色分け()

    'インデックス：A→10、B→26、C→23、E→45、D→39
    If sws.Range("E" & i) = "A" Then
     Selection.Font.ColorIndex = 10
     ElseIf sws.Range("E" & i) = "B" Then
     Selection.Font.ColorIndex = 26
     ElseIf sws.Range("E" & i) = "C" Then
     Selection.Font.ColorIndex = 23
     ElseIf sws.Range("E" & i) = "D" Then
     Selection.Font.ColorIndex = 39
    Else
     Selection.Font.ColorIndex = 45
    End If
    End Sub

1. 課題の整理と解決策の概要

ご質問ありがとうございます。Excel VBAを使ってカレンダー形式のスケジュール管理を実現したいというご要望、素晴らしいですね。現状のコードを拝見し、いくつか改善点が見られました。以下に、課題と解決策を整理します。

課題1： スケジュールのカレンダーへの反映ロジックの不備
解決策： 予定表のデータをカレンダーシートに正しく反映させるためのVBAコードを修正します。日付と年月を正しく比較し、該当するセルに予定を書き込むようにします。
課題2： 重複チェックとメッセージボックスの表示
解決策： 既に予定が入力されている場合に、メッセージボックスを表示し、ユーザーに反映の可否を尋ねる機能を実装します。
課題3： 部署別の色分け
解決策： 部署名に基づいて文字の色を変更する機能を実装します。
課題4： コードの構造と効率性
解決策： コードの可読性を高め、効率的な処理を行うために、変数の宣言、ループ処理、条件分岐などを最適化します。

2. スケジュールをカレンダーに反映させるVBAコードの実装

まずは、予定表のデータをカレンダーに反映させるためのVBAコードを実装します。以下の手順とコード例を参考にしてください。

2.1. シートと変数の定義

最初に、必要なシートと変数を定義します。これにより、コードの可読性が向上し、メンテナンスも容易になります。


Sub ScheduleToCalendar()

    Dim wsCalendar As Worksheet ' カレンダーシート
    Dim wsSchedule As Worksheet ' 予定表シート
    Dim lastRow As Long ' 予定表の最終行
    Dim i As Long ' ループカウンタ
    Dim scheduleDate As Date ' 予定の日付
    Dim calendarYear As Integer ' カレンダーの年
    Dim calendarMonth As Integer ' カレンダーの月
    Dim cellRow As Long ' カレンダーの行
    Dim cellColumn As Long ' カレンダーの列
    Dim scheduleText As String ' カレンダーに表示する予定のテキスト

    ' シートオブジェクトの設定
    Set wsCalendar = ThisWorkbook.Sheets("カレンダー")
    Set wsSchedule = ThisWorkbook.Sheets("予定表")

    ' カレンダーの年と月を取得（スピンボタンで変更される前提）
    calendarYear = wsCalendar.Range("B3").Value ' 年
    calendarMonth = wsCalendar.Range("D3").Value ' 月

    ' 予定表の最終行を取得
    lastRow = wsSchedule.Cells(Rows.Count, "A").End(xlUp).Row

    ' 画面更新を一時的に停止
    Application.ScreenUpdating = False

    ' ... (以下、詳細な処理)

    ' 画面更新を再開
    Application.ScreenUpdating = True

End Sub

2.2. 予定表データの読み込みとカレンダーへの書き込み

次に、予定表のデータを読み込み、カレンダーシートの適切なセルに書き込む処理を実装します。日付、年、月を比較し、一致するセルに予定を表示します。


    ' 予定表の各行をループ処理
    For i = 2 To lastRow
        ' 予定の日付を取得
        scheduleDate = wsSchedule.Cells(i, "A").Value

        ' 年と月が一致するか確認
        If Year(scheduleDate) = calendarYear And Month(scheduleDate) = calendarMonth Then
            ' カレンダーの行と列を計算
            cellRow = 5 + Day(scheduleDate) - 1 ' 例：5行目から開始
            cellColumn = Application.WorksheetFunction.WeekNum(scheduleDate) - Application.WorksheetFunction.WeekNum(DateSerial(Year(scheduleDate), Month(scheduleDate), 1)) + 2 ' 例：2列目から開始

            ' 予定のテキストを作成
            scheduleText = wsSchedule.Cells(i, "C").Value & " " & wsSchedule.Cells(i, "D").Value & " " & wsSchedule.Cells(i, "F").Value

            ' カレンダーに既に予定があるか確認
            If wsCalendar.Cells(cellRow, cellColumn).Value <> "" Then
                ' 重複確認のメッセージボックス
                If MsgBox("同日に既に予定があります。反映しますか？", vbYesNo + vbQuestion, "確認") = vbYes Then
                    ' 改行を追加して予定を追記
                    wsCalendar.Cells(cellRow, cellColumn).Value = wsCalendar.Cells(cellRow, cellColumn).Value & vbLf & scheduleText
                    '部署別の色分け
                    Call ColorCode(wsSchedule.Cells(i, "E").Value, wsCalendar.Cells(cellRow, cellColumn))
                Else
                    ' 処理を中断
                    GoTo NextSchedule
                End If
            Else
                ' カレンダーに予定を書き込む
                wsCalendar.Cells(cellRow, cellColumn).Value = scheduleText
                '部署別の色分け
                Call ColorCode(wsSchedule.Cells(i, "E").Value, wsCalendar.Cells(cellRow, cellColumn))
            End If
        End If
NextSchedule:
    Next i

2.3. 重複チェックとメッセージボックスの実装

同日に既に予定がある場合は、メッセージボックスを表示し、ユーザーに反映の可否を尋ねる機能を実装します。


            ' カレンダーに既に予定があるか確認
            If wsCalendar.Cells(cellRow, cellColumn).Value <> "" Then
                ' 重複確認のメッセージボックス
                If MsgBox("同日に既に予定があります。反映しますか？", vbYesNo + vbQuestion, "確認") = vbYes Then
                    ' 改行を追加して予定を追記
                    wsCalendar.Cells(cellRow, cellColumn).Value = wsCalendar.Cells(cellRow, cellColumn).Value & vbLf & scheduleText
                    '部署別の色分け
                    Call ColorCode(wsSchedule.Cells(i, "E").Value, wsCalendar.Cells(cellRow, cellColumn))
                Else
                    ' 処理を中断
                    GoTo NextSchedule
                End If
            Else
                ' カレンダーに予定を書き込む
                wsCalendar.Cells(cellRow, cellColumn).Value = scheduleText
                '部署別の色分け
                Call ColorCode(wsSchedule.Cells(i, "E").Value, wsCalendar.Cells(cellRow, cellColumn))
            End If

2.4. 部署別の色分けの実装

部署名に基づいて文字の色を変更する機能を実装します。以下のコードを参考に、部署ごとの色分けを設定してください。


Sub ColorCode(department As String, targetCell As Range)

    Select Case department
        Case "A"
            targetCell.Font.ColorIndex = 10 ' 緑
        Case "B"
            targetCell.Font.ColorIndex = 26 ' 赤
        Case "C"
            targetCell.Font.ColorIndex = 23 ' 青
        Case "D"
            targetCell.Font.ColorIndex = 39 ' マゼンタ
        Case "E"
            targetCell.Font.ColorIndex = 45 ' シアン
        Case Else
            targetCell.Font.ColorIndex = xlAutomatic ' デフォルトの色
    End Select

End Sub

2.5. 全体のコード

上記を統合した、完成版のコードです。このコードをVBAエディタにコピーして、シート名などを必要に応じて修正して使用してください。


Sub ScheduleToCalendar()

    Dim wsCalendar As Worksheet ' カレンダーシート
    Dim wsSchedule As Worksheet ' 予定表シート
    Dim lastRow As Long ' 予定表の最終行
    Dim i As Long ' ループカウンタ
    Dim scheduleDate As Date ' 予定の日付
    Dim calendarYear As Integer ' カレンダーの年
    Dim calendarMonth As Integer ' カレンダーの月
    Dim cellRow As Long ' カレンダーの行
    Dim cellColumn As Long ' カレンダーの列
    Dim scheduleText As String ' カレンダーに表示する予定のテキスト

    ' シートオブジェクトの設定
    Set wsCalendar = ThisWorkbook.Sheets("カレンダー")
    Set wsSchedule = ThisWorkbook.Sheets("予定表")

    ' カレンダーの年と月を取得（スピンボタンで変更される前提）
    calendarYear = wsCalendar.Range("B3").Value ' 年
    calendarMonth = wsCalendar.Range("D3").Value ' 月

    ' 予定表の最終行を取得
    lastRow = wsSchedule.Cells(Rows.Count, "A").End(xlUp).Row

    ' 画面更新を一時的に停止
    Application.ScreenUpdating = False

    ' 予定表の各行をループ処理
    For i = 2 To lastRow
        ' 予定の日付を取得
        scheduleDate = wsSchedule.Cells(i, "A").Value

        ' 年と月が一致するか確認
        If Year(scheduleDate) = calendarYear And Month(scheduleDate) = calendarMonth Then
            ' カレンダーの行と列を計算
            cellRow = 5 + Day(scheduleDate) - 1 ' 例：5行目から開始
            cellColumn = Application.WorksheetFunction.WeekNum(scheduleDate) - Application.WorksheetFunction.WeekNum(DateSerial(Year(scheduleDate), Month(scheduleDate), 1)) + 2 ' 例：2列目から開始

            ' 予定のテキストを作成
            scheduleText = wsSchedule.Cells(i, "C").Value & " " & wsSchedule.Cells(i, "D").Value & " " & wsSchedule.Cells(i, "F").Value

            ' カレンダーに既に予定があるか確認
            If wsCalendar.Cells(cellRow, cellColumn).Value <> "" Then
                ' 重複確認のメッセージボックス
                If MsgBox("同日に既に予定があります。反映しますか？", vbYesNo + vbQuestion, "確認") = vbYes Then
                    ' 改行を追加して予定を追記
                    wsCalendar.Cells(cellRow, cellColumn).Value = wsCalendar.Cells(cellRow, cellColumn).Value & vbLf & scheduleText
                    '部署別の色分け
                    Call ColorCode(wsSchedule.Cells(i, "E").Value, wsCalendar.Cells(cellRow, cellColumn))
                Else
                    ' 処理を中断
                    GoTo NextSchedule
                End If
            Else
                ' カレンダーに予定を書き込む
                wsCalendar.Cells(cellRow, cellColumn).Value = scheduleText
                '部署別の色分け
                Call ColorCode(wsSchedule.Cells(i, "E").Value, wsCalendar.Cells(cellRow, cellColumn))
            End If
        End If
NextSchedule:
    Next i

    ' 画面更新を再開
    Application.ScreenUpdating = True

    MsgBox "カレンダーへの反映が完了しました。"

End Sub

Sub ColorCode(department As String, targetCell As Range)

    Select Case department
        Case "A"
            targetCell.Font.ColorIndex = 10 ' 緑
        Case "B"
            targetCell.Font.ColorIndex = 26 ' 赤
        Case "C"
            targetCell.Font.ColorIndex = 23 ' 青
        Case "D"
            targetCell.Font.ColorIndex = 39 ' マゼンタ
        Case "E"
            targetCell.Font.ColorIndex = 45 ' シアン
        Case Else
            targetCell.Font.ColorIndex = xlAutomatic ' デフォルトの色
    End Select

End Sub

3. コードの実行方法と注意点

上記のコードをExcelのVBAエディタに貼り付け、以下の手順で実行してください。

Excelを開き、Alt + F11キーを押してVBAエディタを開きます。
「挿入」メニューから「標準モジュール」を選択します。
上記のコードをモジュールにコピー＆ペーストします。
シート名（”カレンダー”、”予定表”）が正しいか確認し、必要に応じて修正します。
カレンダーシートの年と月のスピンボタンが正しく機能しているか確認します。
VBAエディタで、ScheduleToCalendarプロシージャを実行します（カーソルをプロシージャ内に置いてF5キーを押すか、実行ボタンをクリックします）。

注意点：

コードを実行する前に、必ずExcelファイルをバックアップしてください。
シート名やセルの参照が正しいか確認してください。
スピンボタンの動作を確認し、年と月が正しく切り替わるようにしてください。
エラーが発生した場合は、エラーメッセージをよく確認し、コードを修正してください。

4. 実践的な応用とさらなる改善

このコードをベースに、さらに機能を追加したり、使いやすく改善したりすることができます。以下に、いくつかの応用例と改善点を示します。

4.1. 予定の編集機能： カレンダーに表示された予定をダブルクリックすると、予定の詳細を編集できるフォームを表示する機能を実装します。
4.2. 検索機能： 部署や予定名で予定を検索できる機能を実装します。
4.3. データの入力規則： 予定表の部署名や種別（全日、半日）に、入力規則を設定して、入力ミスを減らします。
4.4. ユーザーインターフェースの改善： ユーザーフォームを作成し、予定の入力や編集をより直感的に行えるようにします。
4.5. エラー処理の強化： 入力データの検証を行い、不正なデータが入力された場合の処理を実装します。

これらの機能を実装することで、より高度なスケジュール管理システムを構築できます。VBAの学習を進めながら、ぜひ挑戦してみてください。

5. まとめと次のステップ

この記事では、Excel VBAを使ってカレンダー形式のスケジュール管理を実現する方法を解説しました。具体的なコード例とステップを参考に、ご自身の業務に合わせてカスタマイズしてみてください。VBAのスキルを向上させることで、Excelの可能性を最大限に引き出し、業務効率を大幅に改善することができます。

もし、この記事を読んでもまだ不安な点があったり、もっと詳しく知りたいこと、あるいは他の仕事に関する悩みなどがありましたら、どうぞお気軽にご相談ください。あなたのキャリアを全力でサポートします。

もっとパーソナルなアドバイスが必要なあなたへ

この記事では一般的な解決策を提示しましたが、あなたの悩みは唯一無二です。
AIキャリアパートナー「あかりちゃん」が、LINEであなたの悩みをリアルタイムに聞き、具体的な求人探しまでサポートします。

今すぐLINEで「あかりちゃん」に無料相談する

無理な勧誘は一切ありません。まずは話を聞いてもらうだけでも、心が軽くなるはずです。

コメントするコメントをキャンセル

お役立ちコンテンツ

転職体験談

転職ノウハウ

転職コラム

コミュ力が、
最強の武器
になる。

まずは登録