2020/06/11

週ごとに切り替え可能な業務日程線




１．背景

業務日程などで「実施項目」「開始日」「終了日」の組み合わせで表を作成することがあると思います。また、その「開始日」「終了日」のデータを使って日程線を引き、他の項目との関係（工程が前後していないか、期間は適切か）や担当者の負荷を見えるようにすることも多いと思います。
日程線を引くには、手書きを除けばワークシート関数の「REPT」を使ったりとか、表示位置と開始・終了日付との関係から線を引く・引かないを数式にしてセルに貼り付ける、などの手法があります。
また日程が長期に渡る場合には、多くの列数を使う必要が出てきて、なかなか思うようなものが作れない事も良くあります。

そこで今回は１週間の範囲の中で日程線を表示し、前週・次週をボタンで送れる業務日程表を作りました。
正直に言えば日程線を引く工程も、視覚的に動かす（図形の矢印をマウスで動かす、スクロールバーで日程を動かす等）手法も紹介したかったのですが、どうにも気に入ったものが完成せず、日程線だけのアプリになってしまいました。
中途半端なアプリですが、何かの参考になれば嬉しいです。


２．概要

外観は図２－１の通り、項目と開始日・終了日の列があり、その右に１週間の日付欄があります。その日付欄の下には、開始・終了日に合わせた日程線が表示されています。

図２－１

日付欄の上に「前週」「次週」を表示するためのボタンがあり、そのボタンを押すと、表示日付に従って日程線が１週間ずつズレていく　というものです。
もちろん、「開始も終了も決まっていない項目」は日程線が引かれませんし、「開始日しか決まっていない項目」は、５行目のように開始日のところにしか日程線がありません。
また、開始・終了日を手入力すると、自動的に日程線が引かれます。

３．プログラム

ワークシート面上に「前週」「次週」のボタンを配置しています。このボタンをクリックすることで登録マクロを動かして画面を切り替え、また開始・終了日を入力した（＝値を変更した）ことでイベントプロシージャを動かし、ボタンと同様に画面切り替えを行います。

３－１．ワークシート面

ワークシート面には、基準日（表示週の初日＝日曜日）をＢ１セルに配置し、その基準日を元にＦ２～Ｌ２セルに１週間の日付を計算値として表示しています。

図３－１

また、Ｆ１・Ｌ１セルにはコマンドボタンを配置します。Ｆ１セル側は「前週」を表す「LastWeek」マクロを登録（図３－２）し、Ｌ１セル側は「次週」の「NextWeek」マクロを登録します。

図３－２

３－２．定数の宣言（標準モジュールの先頭）

先に、標準モジュールの先頭で宣言してある「定数」から説明します。
  1. '==========　⇩①　定数の宣言　==============
  2. Public Const ThisWeek As String = "B1"　 '週の基準日の位置
  3. Public Const S_Day As Long = 4　　　　　 '開始日の列位置
  4. Public Const E_Day As Long = 5　　　　　 '終了日の列位置
  5. Public Const Start_Col As Long = 6　　　 '日程線範囲の開始列
  6. Public Const Start_Row As Long = 4　　　 '日程線範囲の開始行
  7. Public Const Week_Col As Long = 7　　　　 '日程線範囲の幅
  8. Const Arrow As String = "= = ="　　　　　　 '日程線のマーク
図３－３

７つの定数を宣言してありますが、これはワークシート面のレイアウトを図３－４の通り位置決めしたもので、主にデータの範囲（例えば、開始日が記入してある範囲）や、データを貼り付ける範囲（図３－４であれば、Ｆ４～Ｌ１１）を既定するものです。

図３－４

レイアウト位置を定数にしておくと、ワークシート上のレイアウトを変更した際にプログラムを（ほとんど）修正しなくても良くなります。作り始めは面倒だと思うかもしれませんが、後から楽が出来ます。
最も悪いのは、定数とリテラル値（＝値そのもの）を混ぜてしまう事です。修正したはずが修正されておらず「正しく動いていそうだけど実は正しくない」という現象が起こります。

尚、図３－４内の「LastRow」は変化する値ですので、標準モジュール内の関数（Functionプロシージャ）で都度計算するようにしています。

３－３．ワークシートのコード

まず、ワークシート上に配置した前週・次週移動ボタンに登録するマクロが必要です。（図３－５）
今回はワークシートモジュールに記載しましたが、もちろん標準モジュールに記載してもボタン登録できます。
  1. '==========　⇩②　前週・次週の切り替え　============
  2. Sub NextWeek()
  3. 　Sheet1.Range(ThisWeek) = Sheet1.Range(ThisWeek) + Week_Col
  4. 　Call NewPage
  5. End Sub
  7. Sub LastWeek()
  8. 　Sheet1.Range(ThisWeek) = Sheet1.Range(ThisWeek) - Week_Col
  9. 　Call NewPage
  10. End Sub
図３－５

１０～１３行目は「次週」ボタンに登録するマクロ、１５～１８行目は「前週」ボタンに登録するマクロです。
内容としては、１１行目で「表示週の基準日」に１週間分（＝Week_Col）の日にちを足すことで、日付の表示を次週にジャンプしています。
１６行目は逆に１週間分（＝Week_Col）の日にちを引くことで、前週にジャンプしています。

また、日付をズラしたあとで、１２行目・１７行目では「NewPage」というプロシージャを呼び出しています。この「NewPage」は、「各データ行の開始日・終了日を調べて、日程線を引く」動作をします。（図３－１１で詳細説明します。）


ワークシートモジュールには、もう一つイベントプロシージャを記載しています。（図３－６）
  1. '==========　⇩③　開始日・終了日を変更した時のイベントプロシージャ　=================
  2. Private Sub Worksheet_Change(ByVal Target As Range)
  3. 　Dim T As Range
  4. 　For Each T In Target
  5. 　　If T.Row >= Start_Row And T.Row <= LastRow Then
  6. 　　　Select Case T.Column
  7. 　　　　Case S_Day, E_Day
  8. 　　　　　Call NewPage
  9. 　　　End Select
  10. 　　End If
  11. 　Next T
  12. End Sub
図３－６

２０行目のイベントは「ワークシート上で、セルの値を変更した時」に発生するChangeイベントを利用しています。
２１行目の「Dim T As Range」は、引数Targetが複数のセル範囲である場合に、その１つ１つのセルについて調べるために、TというRange変数を宣言しています。
その変数Tを使い、２２行目で引数Targetを分解して１つ１つ調べています。

ここで「For Each～Next では無く、直接Target.Row や Target.Column を使ったらダメ？」と思われる方もいるかもしれません。
複数セルの値を変更した時は、引数のTargetには変更した複数範囲の情報が確かに渡されます。しかし「Target.Row」や「Target.Column」では、「変更した複数範囲の、左上セルの行位置・列位置」が返ってきます。

例えば図３－７のように、別な行の「項目と開始・終了日」だけをコピーし、新たな行に貼り付けた場合を考えてみましょう。

図３－７

変更したのは図３－７の右図の「A8：E9」セルですから、引数TargetもRange("A8：E9")となります。しかしTarget.Row は「８」、Target.Column は「１」となります。範囲の左上のセル位置についてのRowとColumnだからです。
ですので「Target.Columnを使ってしまうと、開始日・終了日が変更された事が分からない」事が発生する場合があるのです。

なお、１つのセルしか変更していないのであれば、Target.Column等でも意思通りに動きます。
また図３－７の様な変更をした際には、変数Tが「D8セル」「E8セル」「D9セル」「E9セル」の時に、それぞれ２６行目を実行してしまう事になりますので、「For Each～Nextで各セルを確認する」事が必ず正しい訳では有りません。


２３行目では、値変更したセルの行位置を調べ、「Start_Row」と「LastRow（その時点での最終行を計算）」の間に入っているかを判断します。
２４行目では値変更したセルの列位置を調べ、２５行目でS_Day（今回は４列目）またはE_Day（５列目）であれば、２６行目で「NewPageプロシージャ」を呼び出します。
「NewPage」は、「各データ行の開始日・終了日を調べて日程線を引く」動作をしますが、詳細は図３－１１で説明します。

３－３．標準モジュールのコード

図３－８のFunctionプロシージャ「LastRow （＝データの最終行 ）」は、図３－６の２３行目、及び図３－１１の４４行目で使用されるものです。
  1. '==========　⇩④　最終行の取得　============
  2. Public Function LastRow() As Long
  3. 　LastRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
  4. End Function
図３－８

データの最終行を求める方法は様々なサイトで紹介されており、当サイトでも「１行１データの表を複数行１データとして印刷する」の中で、いくつかの手法を説明しています。
上記の図３－８「End(xlUP)」を使用する方法はその１つですが、その考え方を図３－９で説明します。

図３－９

まず「Rows.Count」は、ワークシートの行数を表わしています。Excelのバージョンによって最大行数は異なりますが、ワークシートの一番下の行になります。ですので「Cells(Rows.Count, 1)」は、Ａ列の一番下のセルということになります。
次に、キーボードの「ENDキー」と「矢印キー（今回は↑キー）」を同時に押すと、最初に値が存在するセルでセル移動が停止しますが、この操作が「End(xlUP)」に当たります。
この操作を一番下のセル位置から行うことで、データの一番下のセル位置→行番号が得られる、というものです。

尚、この方法で最終行が得られる前提としては、以下の条件が必要です。
　①Ａ列には必ずデータが入っていること。
　②ワークシートに大量のデータを置いても、Rows.Count行までは並んでいない。

この条件の①について図３－１０で説明します。

図３－１０

図３－９と図３－１０は同じように、ワークシートの１１行目までデータが入っています。しかし、図３－１０はＡ１１セルにデータが入っていないために、「Cells(Rows.Count, 1).End(xlUp)」でセルが移動する先は「Ａ１０セル」になります。
つまり「Ａ列に必ず値が入っているとは限らない」場合には、この方法（少なくともCells(Rows.Count, 1)のように、列に１を指定する方法）は使えません。ですので、必ずデータが入る列を指定することが必要です。

一方条件②についてですが、「移動させる前のセル位置がデータ中にある場合には、データの一番上にセル移動する」ことから、「一番下の行までデータがある場合は、データの一番上の行を指す」事になります。
例えば、１シートに収まらない様な大量のテキストデータをExcelに取り込み、それを各シートに目一杯貼付けていく様なプログラムでは、この「Cells(Rows.Count, 1).End(xlUp)」を使う時は注意が必要となります。


次に、メインの日程線を引く部分が図３－１１です。
  1. '==========　⇩⑤　開始日・終了日から週ごとの日程線を引く　===================
  2. Public Sub NewPage()
  3. 　Dim Data() As String　　　　　　　　　 '←シートに貼り付けるデータの配列
  4. 　Dim Dstart As Variant　　　　　　　　 '←開始日のデータ（データ行分）
  5. 　Dim Dend As Variant　　　　　　　　　 '←終了日のデータ（データ行分）
  6. 　Dim Last_Row As Long　　　　　　　　 '←算出された最終行の値を代入しておく変数
  7. 　Dim myWeek As Date　　　　　　　　　 '←算出された週の基準日(日曜日)の日付値を代入しておく変数
  8. 　Dim i As Long, j As Long　　　　　　　 '←カウント変数
  10. 　Last_Row = LastRow　　　　　　　　　　　　 '←関数を１度だけ動かして、変数に代入して使用
  11. 　myWeek = Sheet1.Range(ThisWeek).Value　　 '←セル値取得を１度だけ動かして、変数に代入して使用
  13. 　ReDim Data(1 To Last_Row - Start_Row + 1, 1 To Week_Col)
  14. 　Dstart = Range(Cells(Start_Row, S_Day), Cells(Last_Row, S_Day))
  15. 　Dend = Range(Cells(Start_Row, E_Day), Cells(Last_Row, E_Day))
  17. 　For i = 1 To Last_Row - Start_Row + 1
  18. 　　Select Case IsEmpty(Dstart(i, 1)) * 2 + IsEmpty(Dend(i, 1))
  19. 　　　Case -3　　　　 '←開始＝空・完了＝空
  20. 　　　Case -2　　　　 '←開始＝空・完了＝有
  21. 　　　　For j = 1 To Week_Col
  22. 　　　　　If (Dend(i, 1) = myWeek + j - 1) Then Data(i, j) = Arrow
  23. 　　　　Next j
  24. 　　　Case -1　　　　 '←開始＝有・完了＝空
  25. 　　　　For j = 1 To Week_Col
  26. 　　　　　If (Dstart(i, 1) = myWeek + j - 1) Then Data(i, j) = Arrow
  27. 　　　　Next j
  28. 　　　Case 0　　　　 '←開始＝有・完了＝有
  29. 　　　　For j = 1 To Week_Col
  30. 　　　　　If (Dstart(i, 1) <= myWeek + j - 1) And (Dend(i, 1) >= myWeek + j - 1) Then Data(i, j) = Arrow
  31. 　　　　Next j
  32. 　　End Select
  33. 　Next i
  34. 　Sheet1.Cells(Start_Row, Start_Col).Resize(Last_Row - Start_Row + 1, Week_Col) = Data
  35. End Sub
図３－１１

４４行目は、LastRow関数（図３－８）を呼び出して、プロシージャ内の変数Last_Rowに代入するものです。このプロシージャ内では「データ最終行の値」を多くの場所で使用しているため、その都度LastRow関数を呼び出すのでは効率が良くありません。そのため、プロシージャ内で１回だけ呼出し、その値をプロシージャ内で共通で使っているのです。

また４５行目では、表示週の初日（＝週の基準日）を変数myWeekに代入しています。この基準日もプロシージャ内で何度も使用しますが、セルの値を取得するために都度のセルアタック防止を目的に１回だけアタックする様にしました。

４７行目では、データを貼り付けるシートサイズ（行数：Last_Row - Start_Row + 1　、列数：Week_Col）に合わせてData配列のサイズにしています。
４８行目は、開始日の列（今回はＤ列）データをデータ行分（Start_Row から Last_Row まで）配列としてDstartに格納し、４９行目は終了日の列（今回はＥ列）データをデータ行分だけ配列としてDendに格納しています。

５１～６８行目は、For～Nextでデータの各行について処理を行っていきます。
その処理内容は、開始日・終了日が空か否かで変わってきますので、５２行目のSelect Case文で仕訳けています。

開始日・終了日の有無の組み合わせは４通りになります。この４通りを仕訳けるには、IF文を二重に使ったり、ANDで条件式を重ねたりする事が多いと思いますが、５２行目では「開始日・終了日のフラグを立てる」方法で仕訳けを行っています。

フラグを立てるという事は、今回で言えば「値が有るか無いか」を「True か False か」で表現することです。そのTrueかFalseを得る関数として、ここではIsEmpty関数を選びました。IsEmpty関数を使うことで「値が無ければTrue（＝－１）」「値が有ればFalse（＝０）」が得られます。

ここまでで開始日・完了日の１つ１つについては仕訳ける事ができますが、「開始日・終了日の有無の組み合わせ」は分かりません。例えば、開始日がTrue（＝－１）で終了日がFalse（＝０）の場合、組み合わせを表すために例えば値を足してみると－１となります。この「－１」という値は「（－１）＋（０）」の計算で得たものですが、「（０）＋（－１）」でも「－１」となりますので、開始日がFalseで終了日がTrueとも読み取れてしまいます。

そこで、フラグ同士をただ数値として足すのでは無く、桁を変えて足してみます。思い付きですが開始日側のフラグを１０倍にし、１倍の終了日側のフラグと足すことを考えてみます。
例えば、開始日がTrue（＝－１）で終了日がFalse（＝０）の場合は、（－１０）＋０＝－１０になります。これであれば他の組み合わせは存在しませんので大丈夫そうです。

しかし、フラグが－１か０の２通りでしたら、片方のフラグを１０倍までする必要はありません。
例えば、開始日がTrue（＝－１）で終了日がFalse（＝０）の場合を考えてみます。この時、表現を簡単にするため、Trueを－１では無く、正の値の１とすることにします。
フラグをあたかも文字列の様に考え「開始日のフラグを左に、終了日のフラグを右に置く」とすると「１０」になります。開始日と終了日が逆のフラグでしたら「０１」となります。これ、何かに似ていると思いませんか？
そう、２進数の配置と同じなのです。

フラグが０か１（本当は－１ですが）の２通りの場合は２進数で表現でき、開始日・終了日の２個を判別するには２桁が必要になるのです。

では、これをExcelの式にするにはどうするのでしょう。
今回２進数ですので、桁を１つ上げるには「２桁目に持ってくる項目のフラグ値を２倍」すれば良いことになります。もし３種類あった場合には３桁が必要ですので、「３桁目に持ってくる項目のフラグ値を２ｘ２＝４倍」にします。


以上の考え方から、開始日を２進数の２桁目にするため、フラグを２倍にし、１桁目の終了日（フラグは１倍のまま）と足し合わせたのが図３－１２になります。

図３－１２

図３－１２の一番右列の値を見れば、開始日に値があるのか否か、また終了日に値があるのか否かが判別できますので、これに沿って処理を仕訳けているのが、図３－１１の５３行目・５４行目・５８行目・６２行目の各Caseになります。

その各処理では、開始日・終了日の有無に加えて、現在の表示週（今回は１週間）のどこに日程線を引くのかを決める必要があります。
表示されている週は、週の基準日（Range(ThisWeek)）からWeek_Col（今回は７日間）分ですので、For j=1 to ･･･で回しながら、表示日付と開始日・終了日の関係をチェックしながら線を引く・引かないを決めています。

これをまとめたのが図３－１３です。

図３－１３

①は、開始日・終了日ともデータが入っていない為、日程線は引きません。（図３－１１の５３行目）
②は、終了日のみのため、表示日付と終了日が合っている場合のみ線を引きます。（図３－１１の５５～５７行目）
③は、開始日のみのため、表示日付と開始日が合っている場合のみ線を引きます。（図３－１１の５９～６１行目）
④は、表示日付が開始日と終了日の間にある場合のみ線を引きます。（図３－１１の６３～６５行目）

尚、描画する「線」はモジュール定数Arrowとして「= = =」を宣言していますが、列幅が広い場合には増やすとかマークを変える必要が出てきます。

このようにして、図３－１１の４７行目でReDimした配列Dataの各要素に線（文字列）を代入していくと、図３－１４の様な配列の中身になります。

図３－１４

このデータを入れた配列Dataを６８行目でワークシートに貼り付けます。
貼り付ける際は、貼り付けるデータ（今回は配列Data）の縦横サイズとワークシート側の縦横サイズが合っていないとエラーが発生します。
６８行目では始点（左上セル）を指定してから、Resizeプロパティでサイズ変更をしていますが、他の方法もあります。
  • ①　Sheet1.Cells(Start_Row, Start_Col).Resize(Last_Row - Start_Row + 1, Week_Col) = Data
  • ②　Range(Sheet1.Cells(Start_Row, Start_Col), Sheet1.Cells(Last_Row, Start_Col + Week_Col - 1)) = Data
  • ③　Sheet1.Cells(Start_Row, Start_Col).Resize(UBound(Data, 1), UBound(Data, 2)) = Data
図３－１５

①が６８行目の方法で、Resizeにはモジュール定数などを使用してサイズ決めしています。
②は左上のセル位置と右下のセル位置を指定しています。①と同様にモジュール定数などを使用しています。
③は左上の始点を指定し、サイズは貼り付けるデータの大きさを取得して決めています。

今回の場合はワークシート上の業務日程フォームが固まっている（縦横サイズが固定、または計測しながらマクロを動かしている）為、どの方法でも問題ありません。縦横の制限があまり無いような場面では③が最もエラーが出にくいと思います。

なお、今回の開始日・終了日の組み合わせフラグは４種類のため、値が「０～－３」と単純でしたが、多くの項目でフラグを立てる場合は、「値の中に、目的とするフラグが立っているのか否か」を確認するのが大変になります。
その場合の手法の１つとして、図３－１６を紹介します。
  1. '==========　⇩④　フラグの１つを取得する　============
  2. Sub test()
  3. 　flag = 12　　　　 '←フラグの集合値（今回の「IsEmpty(Dstart(i, 1)) * 2 + IsEmpty(Dend(i, 1))」相当
  4. 　position = 4　　 '←フラグの位置（＝桁位置）
  6. 　bin = Application.WorksheetFunction.Dec2Bin(flag)　　　　　　　　　 '←２進数に変換
  7. 　bin = Application.WorksheetFunction.Rept("0", position) & bin　　　 '←上位がFalseの場合の処置
  8. 　MsgBox bin & vbCrLf & CBool(Mid(bin, Len(bin) - position + 1, 1))　 '←フラグの位置の値を取得
  9. End Sub
図３－１６

７２行目をフラグの集合値、７３行目を調べるフラグの位置（桁位置）とします。
７５行目で、ワークシート関数のDec2Binを使うことで、フラグ集合値（10進数）を２進数の文字列にすることが出来ます。（例えば、10進数の１０は２進数の「1010」になる）

７６行目は、その得られた２進数文字列の前に、Falseの意味であるゼロを追加しています。これは、上位フラグ（図３－１７の項目８側のフラグ）がFalseであった場合、１０進数に計算した時に桁落ちの様な現象が起きてしまい、２進数に戻した時に「フラグが不明」の状態になるのを防ぐためです。

図３－１７

桁落ちする理由は、上位のフラグがゼロの為ですので、先頭に追加するのはゼロになります。追加する桁数は、図３－１７であれば「４つのゼロ」なのですが、「フラグ集合値の桁を調べて、調べる桁から引いて・・・」と面倒な計算をするよりも「調べる桁位置の数だけゼロを足せば充分」と言う思想で余分にゼロを足しています。
途中でゼロを追加する以外の方法としては、図３－１７で考えると「９桁目（最上位の１つ上）に常に１を置く」ことで桁落ち現象を無くす方法もあります。


４．最後に

項目数が多くなると日程調整が大変になるため、多くの業務管理ソフトでは業務項目に親子関係を設け、大項目の大日程を決めてから中項目を割り振ったり、中項目の積み上げで大項目の大日程が決まったりできるようになっています。
今回紹介したものは、そこまで複雑な管理に対応はできていませんが、親子関係の情報もフラグを使って管理できれば、大項目の日程線と中項目の日程線の線種を変更するくらいの事はできそうだ、と思います。


週ごとに切り替え可能な業務日程線（it-030.xlsm）

セキュリティ向上を目的として「インターネット経由でダウンロードしたOfficeファイル（Excel等）のマクロは、既定でブロック」されるようにOfficeアプリケーションの既定動作が変更になりました。（2022年4月より切替開始）
解除の方法については「ダウンロードファイルのブロック解除方法」を参照下さい。