Excelで曜日を表示する[VBA版]

メインとなる関数と定数部分

Option Explicit

Const TITLE As String = "{year}年{month}月のリスト" ' タイトル名
Const TITLE_CELL As String = "B3"   ' タイトルのセル
Const DATE_START As String = "B4"   ' 日付の開始セル
Const DATEOFTHEWEEK_START As String = "B5"  ' 曜日の開始セル
Const DATA_START As String = "B6"   ' データセルの開始セル
Const DATA_COUNT As Integer = 3 'データセルの行数

' リスト生成エントリーポイント
Public Sub newYear()
    Dim ws As Worksheet
    Dim ret As Boolean

On Error GoTo ErrHandle

    ' 年は入力ボックスを使う
    Dim newYear As String
    newYear = InputBox("新しく作成する年を4桁の西暦年で入力してください。", "新年を入力", year(Now()) + 1)

    ' 年の入力チェック（必須・数字・4桁）
    If (newYear = "" Or Not IsNumeric(newYear) Or Len(newYear) > 4) Then
        Call MsgBox("4桁の西暦年が入力されていないので、続行できませんでした。", vbOKOnly + vbCritical, "中止")
        Exit Sub
    End If

    ' 再描画・自動再計算の停止
    Application.ScreenUpdating = False
    Application.Calculation = XlCalculation.xlCalculationManual
    Application.Cursor = XlMousePointer.xlWait

   ' 既存シートを順次処理する
    For Each ws In Worksheets
        ' シートの値を消去
        Call ws.Cells.Clear

        ' 対象シートは数字で始まり"月"で終わるシート
        If Right$(ws.Name, 1) = "月" And IsNumeric(Left$(ws.Name, 1)) Then

            ' セル値の設定
            ret = SetValue(ws, newYear)

            ' セルのスタイル設定
            If ret Then
                ret = SetStyle(ws, newYear)
            End If
        End If
    Next

    GoTo Finally

ErrHandle:
    Call MsgBox("作成に失敗しました", vbOKOnly + vbCritical)

Finally:
    ' 再描画・自動再計算の再開
    Application.Cursor = XlMousePointer.xlDefault
    Application.ScreenUpdating = True
    Application.Calculation = XlCalculation.xlCalculationAutomatic  

End Sub

1. まずは変数宣言の強制(Option Explicit)と、今回使用する固定的な値を定数宣言しています。

   
   説明

   • Option Explicitは変数宣言を強制するためのものです。これを書いておくと、変数宣言(Dim)していない変数はコンパイルエラーとなります。そのためスペルミスなどの変数を未然に防止することgはできます。
   • VBAの場合、定数はConst宣言をし、その後に定数の値をセットします。

2. 入力ボックスを使って「年」を入力するようにして、「年」のチェックを行っています。チェックで年でないと判断した場合はメッセージを表示して処理を終了します。

   
   説明

   • Input関数は、画面に入力画面を表示して値の入力を要求します。入力した場合は、この関数の戻り値に入力した値が返ります。入力をキャンセルした場合は空の文字が返ります。この関数の第3引数はデフォルトに表示する値です。今回は現在の年に1年加算したものをセットしています。
   • IsNumeric関数は、引数の値が数値かどうかを判定して戻り値として返します。数値ならばTRUEを、数値でなければFALSEを戻り値として返します。
   • Len関数は、引数の文字数を返します。

3. 処理の高速するために、再描画と自動再計算を停止しています。またマウスポインターを待ち状態にします。

   
   説明

   • Application.ScreenUpdatetingは、エクセルの自動再描画を制御するプロパティです。自動再描画を行う場合はTrueを、行わない場合はFalseをセットします。デフォルトはTrueです。画面の書き換え処理は比較的重たい処理です。この自動再描画を停止しておくと、コードを実行する度に行われる画面を書き換えを行わず、Application.ScreenUpdatetingをTrueにセットされた時点で一気に書き換えを行うようになります。
   • Application.Calculationは、エクセルの自動再計算を制御するプロパティです。自動再計算を行わないようにするにはFalseを、行うようにするにはTrueをセットします。デフォルトはTrueです。
   • Application.Cursorは、エクセルのマウスポインターに何を表示するか決めるするプロパティです。今回は「待ち」を表すxlWaitを指定しています。デフォルトはxlDefaultです。マウスポインターを変更することで現在処理中であることをユーザーに伝えることができます。

4. シート名が「月」であることを判定し、「月」であるシートに対して処理を行います。まずそのシートに残っている値をクリアし、値を設定(SetValue関数)し、スタイルの設定(SetStyle関数)を行っています。

   
   説明

   • For Each ws In Worksheets ~ Nextで、全ワークシートから一つずつワークシート(ws)を取り出します。
   • Callは、関数を呼び出すためのもです。書かなくても動作しますが、「これは関数だ！」ということを明示することができるので使うことをお勧めします。
   • Cells.Clearで、全てのセルの値をクリアしています。
   • Right関数は、第1引数で指定した文字列から、第2引数で指定した数値の文字数を右側から取り出して返します。Right("12月", 1)とした場合は、右側から1文字分…月が返ってきます。
   • Left関数は、第1引数で指定した文字列から、第2引数で指定した数値の文字数を左から取り出して返します。Right("12月", 1)とした場合は、左から1文字分…1が返ってきます。
   • Rightの後の$は、戻り値を文字列型(String)で返してくださいという意味です。この$がない場合はバリアント型(Variant)で戻り値を返しています。バリアント型は文字列型よりもメモリーサイズが大きく、また処理もわずかながら遅いので、この$を使っています。

5. 停止していた、再描画と自動計算を再開し、マウスポインターを通常に戻します。

値を設定するSetValue関数

' 日付・曜日などのセル値を設定
Public Function SetValue(ByRef ws As Worksheet, ByVal newYear As Integer)
On Error GoTo ErrHandle

    ' 曜日文字列配列
    Dim dateOfWeek(7) As String
    dateOfWeek(VbDayOfWeek.vbSunday) = "日"
    dateOfWeek(VbDayOfWeek.vbMonday) = "月"
    dateOfWeek(VbDayOfWeek.vbTuesday) = "火"
    dateOfWeek(VbDayOfWeek.vbWednesday) = "水"
    dateOfWeek(VbDayOfWeek.vbThursday) = "木"
    dateOfWeek(VbDayOfWeek.vbFriday) = "金"
    dateOfWeek(VbDayOfWeek.vbSaturday) = "土"  

    ' シート名より月を取得
    Dim newMonth As String
    newMonth = Replace$(ws.Name, "月", "")

    Dim currentCell As Range

    ' タイトルの設定
    Set currentCell = ws.Range(TITLE_CELL)
    currentCell.Value = Replace$(Replace$(TITLE, "{year}", newYear), "{month}", newMonth)

    Dim newDay As Integer
    Dim currentDate As Date

    ' 日付・曜日の設定
    For newDay = 1 To 31 Step 1

        currentDate = DateSerial(newYear, newMonth, newDay)  

        If (month(currentDate) > newMonth) Then
            Exit For
        End If

        Set currentCell = ws.Range(DATE_START).offset(0, newDay - 1)
        currentCell.Value = Day(currentDate)

        Set currentCell = ws.Range(DATEOFTHEWEEK_START).offset(, newDay - 1)
        currentCell.Value = dateOfWeek(Weekday(currentDate))
    Next newDay


    SetValue = True
    GoTo Finally

ErrHandle:
     SetValue = False
Finally:

End Function

1. 曜日文字列を配列で保持しています。この配列の添字は、Weekday関数の戻り値に一致するようにします

   
   説明

   • 配列は指定した要素数+1の要素が作成されます。Dim test(7) As Stringと配列を宣言した場合は、test(0)~test(7)の8個の要素が要素が策されます。
   • 配列の添字は0や1などの数値型を指定します。ここではVbDayOfWeek.vbSundayを添字として指定していますが、VbDayOfWeek.vbSundayは列挙型といわれるもので、値としては数値となります。なのでこのように配列の添字として使うことができます。

2. 入力した「年」と、シート名から取得した「月」と日を元に日付を決定します。

   
   説明

   • DateSerial関数は、引数で指定した「年」(第1引数)、「月」(第2引数)、「日」(第3引数)をもとに日付型を返します。DateSerial(2017, 12, 24)とした場合は2017/12/24の日付型(Date)が返ってきます。

3. 決定した日付が、シート名から取得した「月」と違う場合、処理を終了します。

   
   説明

   • month関数は、引数で指定した日付型から「月」を取り出して数値型で返します。

4. 日付の日を設定します。日が進むに連れて、右側に1つずつoffset関数を使って移動させています。

   
   説明

   • Rangeは、引数で指定したセルを元に、Rangeオブジェクトを返します。例えばRange("A1")とした場合、A1セルを示すRangeオブジェクト(セルを操作するオブジェクト)を返します。
   • Rangeオブジェクトのoffset関数は、第1引数に行方向(縦向き）、第2引数に列方向(横向き）に移動したセル数分の数値を指定します。例えばRange("C1").offset(-1, 2)とした場合は、行方向に-1、列方向に2なので、B3セルのRangeオブジェクトを返します。
   • RangeオブジェクトのValueプロパティは、セルに値をセットしたり、セルから値を取り出したりします。例えばRange("A1").Value = "abc"とした場合、A1セルにabcがセットされます。test = Range("B1").Valueとした場合は、B1セルにセットされている値を取り出して、変数testにセットします。
   • Day関数は、引数で指定した日付型から「日」を取り出して数値型で返します。

5. 曜日を設定します。曜日はWeekday関数を使ってどの曜日かを数値型で取得し、作っておいた曜日配列から曜日の文字を取り出し設定します。

   
   説明

   • DateOfWeek関数は、引数で指定した　日付型の日付をもとに曜日に対応する数値を返します。戻り値の定数は下記の通りです。

     曜日	DateOfWeekの戻り値	対応する列挙型定数
     1	日曜日	vbSunday
     2	月曜日	vbMonday
     3	火曜日	vbTuesday
     4	水曜日	vbWednesday
     5	木曜日	vbThursday
     6	金曜日	vbFriday
     7	土曜日	vbSaturday

スタイルを設定する関数

' 罫線・背景色などの設定
Public Function SetStyle(ByRef ws As Worksheet, ByVal newYear As Integer)
On Error GoTo ErrHandle

    Dim currentCell As Range

    ' シートの全セルの列幅を変更
    ws.Cells.ColumnWidth = 5  

    ' タイトル部（フォントサイズ）
    Set currentCell = ws.Range(TITLE_CELL)
    
    currentCell.Font.Size = 24 


    'データ部（罫線）
    Set currentCell = ws.Range(ws.Range(DATE_START), ws.Range(DATA_START).offset(DATA_COUNT, 31))
    currentCell.Borders().Weight = XlBorderWeight.xlHairline
    Call currentCell.BorderAround(XlLineStyle.xlContinuous, XlBorderWeight.xlThin)

    '日付・曜日部（罫線・背景色・文字揃え）
    Set currentCell = ws.Range(ws.Range(DATE_START), ws.Range(DATEOFTHEWEEK_START).offset(0, 31))
    currentCell.Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlDouble
    currentCell.Interior.Color = RGB(217, 217, 217)
    currentCell.HorizontalAlignment = xlCenter

    SetStyle = True
    GoTo Finally

ErrHandle:
    SetStyle = False

Finally:

End Function

1. シート内の全ての列の幅を変更しています。する場合、CellsオブジェクトのColumnWidthプロパティに値を設定します。ちなみに行高さを変更する場合は、CellsオブジェクトのRowHeightプロパティに値をセットします。

   
   説明

   • CellsオブジェクトのColumnWidthプロパティに値を代入することで、全てのセルの列幅を変更しています。ちなみに行高さを変更する場合は、CellsオブジェクトのRowHeightプロパティに値をセットします。

2. セルのフォントサイズを変更します。

   
   説明

   • RangeオブジェクトのFontオブジェクトのSizeプロパティでフォントのサイズを操作します。Range("A1").Font.Size = 24 とすると、A1セルのフォントサイズを 24に変更することになります。
   • RangeオブジェクトのBordersオブジェクトのWeightプロパティで、線の太さを指定します。Range("A1").Borders().Weight = xlMediumとすると、A1セルの全ての罫線の太さは中太になります。
     

     定数	線の太さ
     xlHairline	極細
     xlThin	細
     xlMedium	中
     xlThick	太

   • RangeオブジェクトのBorderAround関数は、セルの外縁の罫線を作成します。第1引数に線種を、第2引数に線の太さを指定します。例えばRange("A1").BorderAround(xlContinuous, xlThin)とした場合は、A1セルの上・下・右・左の罫線は細い実線となります。

3. セルに対して、罫線及び、文字色、文字揃えを設定します。

   
   説明

   • RangeオブジェクトのBordersは、指定がない場合は全ての罫線が対象になります。例えばRange("A1").Borders()です。個別に指定する場合はBordersに値を渡します。例えばRange("A1").Borders(xlEdgeBottom)の場合は、A1セルの下の罫線のみ対象となります。どの罫線を指定するかは次の図を参考にしてください。
     
   • RangeオブジェクトのBorderオブジェクトのLineStyleプロパティで線種を指定します。例えばRange("A1").Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlDoubleとすると、A1セルの下側罫線を二重線にすることになります。
     

     定数	線の種類
     xlContinuous	細い実線
     xlDash	破線
     xlDashDot	一点鎖線
     xlDashDotDot	二点鎖線
     xlDot	点線
     xlDouble	二重線
     xlSlantDashDot	斜め斜線
     xlLineStyleNone	線なし

   • RangeオブジェクトのInteriorオブジェクトのColorで文字の色を指定します。例えばRange("A1").Interior.Color = vbRedでA1セルの文字色を赤色にしています。色の指定には下記のような値があります。
     

     定数	色
     vbBlack	黒色
     vbRed	赤色
     vbGreed	緑色
     vbBlue	青色
     vbYellow	黄色
     vbMagenta	マゼンタ(明るい紫色っぽい)
     vbCyan	シアン(水色っぽい)
     vbWhite	白色

   • RGB関数は、引数に赤色(第1引数)、緑色(第1引数)、青色(第1引数)に対応する数値(最大255まで)を指定することで、色を指定します。たとえばRGB(255, 255, 255)で白色になります。
   • RangeオブジェクトのHorizontalAlignmentプロパティは、文字揃えを指定します。例えばRange("A1").HorizontalAlignment = xlCenterとすると、A1セルの値は中央揃えになります。

ソースコード

全ソースコードです。標準モジュールなどに貼り付けて実行してみてください。

Option Explicit

    Const TITLE As String = "{year}年{month}月のリスト" ' タイトル名
    Const TITLE_CELL As String = "B3"   ' タイトルのセル
    Const DATE_START As String = "B4"   ' 日付の開始セル
    Const DATEOFTHEWEEK_START As String = "B5"  ' 曜日の開始セル
    Const DATA_START As String = "B6"   ' データセルの開始セル
    Const DATA_COUNT As Integer = 3 'データセルの行数


    ' リスト生成エントリーポイント
    Public Sub newYear()
        Dim ws As Worksheet
        Dim ret As Boolean

    On Error GoTo ErrHandle


        ' 年は入力ボックスを使う
        Dim newYear As String
        newYear = InputBox("新しく作成する年を4桁の西暦年で入力してください。", "新年を入力", year(Now()) + 1)

        ' 年の入力チェック（必須・数字・4桁）
        If (newYear = "" Or Not IsNumeric(newYear) Or Len(newYear) > 4) Then
            Call MsgBox("4桁の西暦年が入力されていないので、続行できませんでした。", vbOKOnly + vbCritical, "中止")
            Exit Sub
        End If

        ' 再描画・自動再計算の停止
        Application.ScreenUpdating = False
        Application.Calculation = XlCalculation.xlCalculationManual
        Application.Cursor = XlMousePointer.xlWait

        ' 既存シートを順次処理する
        For Each ws In Worksheets
            ' シートの値を消去
            Call ws.Cells.Clear

            ' 対象シートは数字で始まり"月"で終わるシート
            If Right$(ws.Name, 1) = "月" And IsNumeric(Left$(ws.Name, 1)) Then

                ' セル値の設定
                ret = SetValue(ws, newYear)

                ' セルのスタイル設定
                If ret Then
                    ret = SetStyle(ws, newYear)
                End If
            End If
        Next

        GoTo Finally

    ErrHandle:
        Call MsgBox("作成に失敗しました", vbOKOnly + vbCritical)

    Finally:
        ' 再描画・自動再計算の再開
        Application.Cursor = XlMousePointer.xlDefault
        Application.ScreenUpdating = True
        Application.Calculation = XlCalculation.xlCalculationAutomatic

    End Sub


    ' 日付・曜日などのセル値を設定
    Public Function SetValue(ByRef ws As Worksheet, ByVal newYear As Integer)
    On Error GoTo ErrHandle

        ' 曜日文字列配列
        Dim dateOfWeek(7) As String
        dateOfWeek(VbDayOfWeek.vbSunday) = "日"
        dateOfWeek(VbDayOfWeek.vbMonday) = "月"
        dateOfWeek(VbDayOfWeek.vbTuesday) = "火"
        dateOfWeek(VbDayOfWeek.vbWednesday) = "水"
        dateOfWeek(VbDayOfWeek.vbThursday) = "木"
        dateOfWeek(VbDayOfWeek.vbFriday) = "金"
        dateOfWeek(VbDayOfWeek.vbSaturday) = "土"


        ' シート名より月を取得
        Dim newMonth As String
        newMonth = Replace$(ws.Name, "月", "")

        Dim currentCell As Range

        ' タイトルの設定
        Set currentCell = ws.Range(TITLE_CELL)
        currentCell.Value = Replace$(Replace$(TITLE, "{year}", newYear), "{month}", newMonth)

        Dim newDay As Integer
        Dim currentDate As Date

        ' 日付・曜日の設定
        For newDay = 1 To 31 Step 1
            currentDate = DateSerial(newYear, newMonth, newDay)

            If (month(currentDate) > newMonth) Then
                Exit For
            End If

            Set currentCell = ws.Range(DATE_START).offset(0, newDay - 1)
            currentCell.Value = Day(currentDate)

            Set currentCell = ws.Range(DATEOFTHEWEEK_START).offset(, newDay - 1)
            currentCell.Value = dateOfWeek(Weekday(currentDate))
        Next newDay


        SetValue = True
        GoTo Finally

    ErrHandle:
        SetValue = False
    Finally:

    End Function


    ' 罫線・背景色などの設定
    Public Function SetStyle(ByRef ws As Worksheet, ByVal newYear As Integer)
    On Error GoTo ErrHandle

        Dim currentCell As Range

        ' シートの全セルの列幅を変更
        ws.Cells.ColumnWidth = 5

        ' タイトル部（フォントサイズ）
        Set currentCell = ws.Range(TITLE_CELL)
        currentCell.Font.Size = 24


        'データ部（罫線）
        Set currentCell = ws.Range(ws.Range(DATE_START), ws.Range(DATA_START).offset(DATA_COUNT, 31))
        currentCell.Borders().Weight = XlBorderWeight.xlHairline
        Call currentCell.BorderAround(XlLineStyle.xlContinuous, XlBorderWeight.xlThin)

        '日付・曜日部（罫線・背景色・文字揃え）
        Set currentCell = ws.Range(ws.Range(DATE_START), ws.Range(DATEOFTHEWEEK_START).offset(0, 31))
        currentCell.Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlDouble
        currentCell.Interior.Color = RGB(217, 217, 217)
        currentCell.HorizontalAlignment = xlCenter

        SetStyle = True
        GoTo Finally

    ErrHandle:
        SetStyle = False

    Finally:

    End Function