【エクセルVBA】カレンダーの土日だけ色を変える方法とRangeオブジェクトの応用的な使い方

2019年8月6日
2019年8月31日
カレンダーアプリ

カレンダーアプリ

みなさん、こんにちはケンケンです。

エクセルVBAを使ってカレンダー作りをしています。

今回は、土曜日と日曜日だけ色を変える方法をご紹介します。

色分けする方法を通して、条件分岐の基本を今一度復習してください。

前回の復習はこちらからどうぞ。

1 前回の復習
2 プロシージャを呼び出すCallステートメントを使おう
- 2.1 プロシージャを一つのプロシージャにまとめる
- 2.2 ボタンを作る
3 セルの色を変える方法
4 WEEKDAY関数とWEEKDAYNAME関数を使ってみよう
5
6 土日だけ色分けしよう
- 6.1 条件分岐で土曜と日曜だけ色分けする
7 まとめ

前回の復習

まずは、前回の復習をします。

前回は、初期化と別シートを検索して転記する方法をご紹介しました。

コードは以下の通りとなります。

Sub hiduke_rensyu10()
    Dim sday '最初の日という意味
    Dim ntuki '次の月を格納
    Dim stuki '翌月の最初の日を格納
    Dim lday '最後の日という意味
    
    ntuki = Range("D2").Value + 1
    If ntuki = 13 Then
        ntuki = 1
        sday = CDate(Range("C2") & "/" & Range("D2") & "/" & "1")
        stuki = CDate(Range("C2") + 1 & "/" & ntuki & "/" & "1")
        lday = stuki - 1
        
    Else
        sday = CDate(Range("C2") & "/" & Range("D2") & "/" & "1")
        stuki = CDate(Range("C2") & "/" & ntuki & "/" & "1")
        lday = stuki - 1
        
    End If
    
    Range("A:B").ClearContents '初期化
    Range("A1").Value = "日付" 
    Range("B1").Value = "主な行事" 
        
    Dim cnt '書き出し先のカウント変数
    cnt = 2
    Do While sday <= lday
        Range("A" & cnt).Value = sday
        sday = DateAdd("d", 1, sday)
        cnt = cnt + 1
    Loop
End Sub

Sub hiduke_rensyu10()

Dim sday '最初の日という意味

Dim ntuki '次の月を格納

Dim stuki '翌月の最初の日を格納

Dim lday '最後の日という意味

ntuki = Range("D2").Value + 1

If ntuki = 13 Then

ntuki = 1

sday = CDate(Range("C2") & "/" & Range("D2") & "/" & "1")

stuki = CDate(Range("C2") + 1 & "/" & ntuki & "/" & "1")

lday = stuki - 1

Else

sday = CDate(Range("C2") & "/" & Range("D2") & "/" & "1")

stuki = CDate(Range("C2") & "/" & ntuki & "/" & "1")

lday = stuki - 1

End If

Range("A:B").ClearContents '初期化

Range("A1").Value = "日付"

Range("B1").Value = "主な行事"

Dim cnt '書き出し先のカウント変数

cnt = 2

Do While sday <= lday

Range("A" & cnt).Value = sday

sday = DateAdd("d", 1, sday)

cnt = cnt + 1

Loop

End Sub

Sub kensaku_offset1()
    Dim cnt
    Dim kensakucnt
    Dim eSheet As Worksheet '検索元イベント一覧シート
    Dim cSheet As Worksheet '転記先カレンダーシート
    Dim motoLrow
    Dim sakiLrow
    
    Set eSheet = Sheets("イベント一覧") 
    Set cSheet = Sheets("カレンダー練習") 
    
    motoLrow = eSheet.Range("A" & Rows.Count).End(xlUp).Row 'イベント一覧シートの最終行
    sakiLrow = cSheet.Range("A" & Rows.Count).End(xlUp).Row 'カレンダー練習シートの最終行
    
    For kensakucnt = 2 To sakiLrow 
        For cnt = 2 To motoLrow 
            If eSheet.Range("A" & cnt).Value = cSheet.Range("A" & kensakucnt).Value Then 
                cSheet.Range("B" & kensakucnt).Value = eSheet.Range("A" & cnt).Offset(0, 1).Value
            End If
        Next
    Next
End Sub

Sub kensaku_offset1()

Dim cnt

Dim kensakucnt

Dim eSheet As Worksheet '検索元イベント一覧シート

Dim cSheet As Worksheet '転記先カレンダーシート

Dim motoLrow

Dim sakiLrow

Set eSheet = Sheets("イベント一覧")

Set cSheet = Sheets("カレンダー練習")

motoLrow = eSheet.Range("A" & Rows.Count).End(xlUp).Row 'イベント一覧シートの最終行

sakiLrow = cSheet.Range("A" & Rows.Count).End(xlUp).Row 'カレンダー練習シートの最終行

For kensakucnt = 2 To sakiLrow

For cnt = 2 To motoLrow

If eSheet.Range("A" & cnt).Value = cSheet.Range("A" & kensakucnt).Value Then

cSheet.Range("B" & kensakucnt).Value = eSheet.Range("A" & cnt).Offset(0, 1).Value

End If

End Sub

今回は、このコードをさらにカスタマイズします。

具体的には、土曜日と日曜日のみ色を変えてカレンダーらしくしていきます。

プロシージャを呼び出すCallステートメントを使おう

色を変える前に上記２つのプロシージャをひとつのプロシージャに統合しておきましょう。

プロシージャを一つのプロシージャにまとめる

プロシージャをまとめる方法は以下のようになります。

Sub calendar_app()
    Call hiduke_rensyu10
    Call kensaku_offset1
End Sub

Sub calendar_app()

Call hiduke_rensyu10

Call kensaku_offset1

End Sub

新しく「calendar_app」というプロシージャを作成し、Callステートメントでプロシージャを呼び出します。

Callステートメントは

Call name

という構文となっていて、nameの部分にプロシージャ名を指定することで目的のプロシージャを呼び出せます。

なお、Callは省略することができますが、いきなりコードの途中で他のプロシージャ名が前置きなくあらわれると可読性が低くなると考えるので、Callは省略しない方がよいでしょう。

それでは、２つのプロシージャをひとつにして実行できるか確認してください。

ボタンを作る

せっかくプロシージャをまとめた部品ができたので、ボタンを作っておきましょう。

「開発」の「挿入」からボタンを選択し、さらに、calendar_appプロシージャを選択しボタンを作成します。

セルの色を変える方法

以前に条件付き書式を使って土日だけ色を変えましたが、今回は、VBAで色を変える方法をご紹介します。

colorIndexプロパティで色付けしよう

セルの色を変えることはInteriorオブジェクトのcolorIndexプロパティを操作することで可能です。

InteriorオブジェクトはRangeオブジェクトの配下として使います。

colorIndexプロパティについてはこちらの記事でも取り扱っているのでよかったらご覧ください。

言葉では理解するのが難しいので、具体的にコードを書いてみます。

Sub cell_color()
    Range("A1").Interior.ColorIndex = 10
End Sub

Sub cell_color()

Range("A1").Interior.ColorIndex = 10

End Sub

コードにするとすっきりしますね。

右辺の１０は色の番号をあらわしています。１０番は緑のようです。

僕も覚えていません。

ちなみに、青は５、赤は３のようです。

今回は、この数字を使っていきます。

複数のセルに同時に色付けしよう

今度は、複数のセルに色付けします。

Rangeオブジェクトを工夫すればできそうですね。

A2からB3セルに色を付けてみます。

Sub cell_color()
    Range("A1").Interior.ColorIndex = 10
    Range("A2:B3").Interior.ColorIndex = 5 '①
End Sub

Sub cell_color()

Range("A1").Interior.ColorIndex = 10

Range("A2:B3").Interior.ColorIndex = 5 '①

End Sub

①Rangeオブジェクトのセル範囲をA2:B3とすれば問題なくできますね。

特に説明は必要ないと思います。

変数を使って色付けしよう

範囲指定して色付けできたので、次は変数を使って範囲を表現しRangeオブジェクトを使います。

A4からC5セルに色を付けてみましょう。

変数を挿入する場合は少しコツが必要です。

コードをご覧ください。

Sub cell_color()
    Range("A1").Interior.ColorIndex = 10
    Range("A2:B3").Interior.ColorIndex = 5 '①
    Range("A" & "4" & ":" & "C" & "5").Interior.ColorIndex = 3 '②
End Sub

Sub cell_color()

Range("A1").Interior.ColorIndex = 10

Range("A2:B3").Interior.ColorIndex = 5 '①

Range("A" & "4" & ":" & "C" & "5").Interior.ColorIndex = 3 '②

End Sub

②前段として変数を使う前にRangeオブジェクトの範囲を細かく分けます。

ダブルクォーテーション（””）と＆をうまく使うと分離できます。

ここまでできたら、変数を宣言し、数字の部分を変更することで変数に置き換えることができます。

Sub cell_color()
    Range("A1").Interior.ColorIndex = 10
    Range("A2:B3").Interior.ColorIndex = 5 '①
    'Range("A" & "4" & ":" & "C" & "5").Interior.ColorIndex = 3 '②
    
    Dim hensu1
    Dim hensu2
    hensu1 = 4
    hensu2 = 5
    Range("A" & hensu1 & ":" & "C" & hensu2).Interior.ColorIndex = 3 '③
End Sub

Sub cell_color()

Range("A1").Interior.ColorIndex = 10

Range("A2:B3").Interior.ColorIndex = 5 '①

'Range("A" & "4" & ":" & "C" & "5").Interior.ColorIndex = 3 '②

Dim hensu1

Dim hensu2

hensu1 = 4

hensu2 = 5

Range("A" & hensu1 & ":" & "C" & hensu2).Interior.ColorIndex = 3 '③

End Sub

③変数を２つ用意しそれぞれに数字を格納します。

そして、Rangeオブジェクトの範囲の中に変数を入れます。

挙動を確認するために②はコメントアウトしておきます。

実行して下図のようになれば成功です。

WEEKDAY関数とWEEKDAYNAME関数を使ってみよう

VBAで曜日を表現する時に使う関数はWEEKDAY関数とWEEKDAYNAME関数です。

これらを使って、日付データから曜日を取り出しシートに書き出してみましょう。

WEEKDAY関数を使ってみよう

シートに日付を用意しました。

B1セルにWEEKDAY関数を使って曜日の数値を書き出してみます。

Sub cell_color2()
    Range("B1").Value = Weekday(Range("A1"))
End Sub

Sub cell_color2()

Range("B1").Value = Weekday(Range("A1"))

End Sub

これを実行すると以下のようになります。

数値で書き出せました。ただし、このままでは資料として使えないので数値に該当する曜日を表現したいですね。

曜日を表現するWEEKDAYNAME関数を使ってみよう

VBA特有の関数、WEEKDAYNAME関数を使うと一発で曜日を表記してくれるので便利です。

WeekdayName(曜日)

曜日の中に１～７の数値を入れると、それに該当する曜日を返してくれます。

Sub cell_color2()
    Range("B1").Value = Weekday(Range("A1"))
    Range("B1").Value = WeekdayName(6)
End Sub

Sub cell_color2()

Range("B1").Value = Weekday(Range("A1"))

Range("B1").Value = WeekdayName(6)

End Sub

上記コードを実行すると「金曜日」を返してくれます。

この性質を利用します。

WEEKDAYNAME関数の引数に直接WEEKDAY関数を代入してしまえば、WEEKDAY関数で計算した数値をすぐにWEEKDAYNAME関数で曜日に変換してくれそうです。

具体的には以下のようにします。

Sub cell_color2()
    'Range("B1").Value = Weekday(Range("A1"))
    'Range("B1").Value = WeekdayName(6)
    Range("B1").Value = WeekdayName(Weekday(Range("A1"))) 'WeekdayNameとWeekdayを組み合わせる
End Sub

Sub cell_color2()

'Range("B1").Value = Weekday(Range("A1"))

'Range("B1").Value = WeekdayName(6)

Range("B1").Value = WeekdayName(Weekday(Range("A1"))) 'WeekdayNameとWeekdayを組み合わせる

End Sub

１行目と２行目を組み合わせると３行目になります。

実行すると当然「金曜日」を返します。

ループさせよう

さて、ここまでできたので繰り返し処理をしていきます。

カウント変数cntを用意して、１０行目まで回していきましょう

コードは以下の通りです。

Sub cell_color2()
    Dim cnt
    For cnt = 1 To 10
        Range("B" & cnt).Value = WeekdayName(Weekday(Range("A" & cnt))) 'WeekdayNameとWeekdayを組み合わせる
    Next
End Sub

Sub cell_color2()

Dim cnt

For cnt = 1 To 10

Range("B" & cnt).Value = WeekdayName(Weekday(Range("A" & cnt))) 'WeekdayNameとWeekdayを組み合わせる

End Sub

10行目まで曜日を書き出せれば成功です。

土日だけ色分けしよう

今回のハイライトです。

Rangeオブジェクトの範囲指定の仕方と曜日を書き出す方法を組み合わせて、土日だけ色を変えてみましょう。

まずは、コードの完成形をお見せします。

Sub cell_color2()
    Dim cnt
    For cnt = 1 To 10
        Range("B" & cnt).Value = WeekdayName(Weekday(Range("A" & cnt)))
        If Weekday(Range("A" & cnt)) = 7 Then '①
            Range("A" & cnt & ":" & "B" & cnt).Interior.ColorIndex = 5 '②
        ElseIf Weekday(Range("A" & cnt)) = 1 Then '③
            Range("A" & cnt & ":" & "B" & cnt).Interior.ColorIndex = 3 '④
        End If
    Next
End Sub