アトム電器 三軒家店(有限会社 おかもとでんか)のホームページ。大阪市大正区にある町の電気屋さん。家電製品の販売、エアコン、電気工事、パソコンからリフォーム、オール電化など電気のことならなんでもお任せ下さい!アトム電器三軒家店

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

Excel開発 VBA開発

日付と曜日の表示をVBAを使って設定する方法を説明します。サンプルとして次のようなExcelをつくる場合で説明します。月ごとにシートが分かれていて、横方向に日付を表示して、その下に曜日を表示するような表です。
完成図

画面イメージははmacOSのExcel 15.6ですが、VBA自体はWindows版 Excelでコーディング・テストしています。(macOS版のExcelでもコーディングできるみたいですが、コード補助機能などで問題があってコーディングが進まないのでWindows版でコーディングしました。)

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

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セルの下の罫線のみ対象となります。どの罫線を指定するかは次の図を参考にしてください。
      Bordersの定数
    • 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