2020/06/11

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




1.背景

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

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


2.概要

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

図2-1

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

3.プログラム

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

3-1.ワークシート面

ワークシート面には、基準日(表示週の初日=日曜日)をB1セルに配置し、その基準日を元にF2~L2セルに1週間の日付を計算値として表示しています。

図3-1

また、F1・L1セルにはコマンドボタンを配置します。F1セル側は「前週」を表す「LastWeek」マクロを登録(図3-2)し、L1セル側は「次週」の「NextWeek」マクロを登録します。

図3-2

3-2.定数の宣言(標準モジュールの先頭)

先に、標準モジュールの先頭で宣言してある「定数」から説明します。
  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 = "= = ="       '日程線のマーク
図3-3

7つの定数を宣言してありますが、これはワークシート面のレイアウトを図3-4の通り位置決めしたもので、主にデータの範囲(例えば、開始日が記入してある範囲)や、データを貼り付ける範囲(図3-4であれば、F4~L11)を既定するものです。

図3-4

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

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

3-3.ワークシートのコード

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

10~13行目は「次週」ボタンに登録するマクロ、15~18行目は「前週」ボタンに登録するマクロです。
内容としては、11行目で「表示週の基準日」に1週間分(=Week_Col)の日にちを足すことで、日付の表示を次週にジャンプしています。
16行目は逆に1週間分(=Week_Col)の日にちを引くことで、前週にジャンプしています。

また、日付をズラしたあとで、12行目・17行目では「NewPage」というプロシージャを呼び出しています。この「NewPage」は、「各データ行の開始日・終了日を調べて、日程線を引く」動作をします。(図3-11で詳細説明します。)


ワークシートモジュールには、もう一つイベントプロシージャを記載しています。(図3-6)
  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
図3-6

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

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

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

図3-7

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

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


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

3-3.標準モジュールのコード

図3-8のFunctionプロシージャ「LastRow (=データの最終行 )」は、図3-6の23行目、及び図3-11の44行目で使用されるものです。
  1. '========== ⇩④ 最終行の取得 ============
  2. Public Function LastRow() As Long
  3.  LastRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
  4. End Function
図3-8

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

図3-9

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

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

この条件の①について図3-10で説明します。

図3-10

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

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


次に、メインの日程線を引く部分が図3-11です。
  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        '←カウント変数
  9.  Last_Row = LastRow             '関数を1度だけ動かして、変数に代入して使用
  10.  myWeek = Sheet1.Range(ThisWeek).Value   'セル値取得を1度だけ動かして、変数に代入して使用
  11.  ReDim Data(1 To Last_Row - Start_Row + 1, 1 To Week_Col)
  12.  Dstart = Range(Cells(Start_Row, S_Day), Cells(Last_Row, S_Day))
  13.  Dend = Range(Cells(Start_Row, E_Day), Cells(Last_Row, E_Day))
  14.  For i = 1 To Last_Row - Start_Row + 1
  15.   Select Case IsEmpty(Dstart(i, 1)) * 2 + IsEmpty(Dend(i, 1))
  16.    Case -3     '←開始=空・完了=空
  17.    Case -2     '←開始=空・完了=有
  18.     For j = 1 To Week_Col
  19.      If (Dend(i, 1) = myWeek + j - 1) Then Data(i, j) = Arrow
  20.     Next j
  21.    Case -1     '←開始=有・完了=空
  22.     For j = 1 To Week_Col
  23.      If (Dstart(i, 1) = myWeek + j - 1) Then Data(i, j) = Arrow
  24.     Next j
  25.    Case 0     '←開始=有・完了=有
  26.     For j = 1 To Week_Col
  27.      If (Dstart(i, 1) <= myWeek + j - 1) And (Dend(i, 1) >= myWeek + j - 1) Then Data(i, j) = Arrow
  28.     Next j
  29.   End Select
  30.  Next i
  31.  Sheet1.Cells(Start_Row, Start_Col).Resize(Last_Row - Start_Row + 1, Week_Col) = Data
  32. End Sub
図3-11

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

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

47行目では、データを貼り付けるシートサイズ(行数:Last_Row - Start_Row + 1 、列数:Week_Col)に合わせてData配列のサイズにしています。
48行目は、開始日の列(今回はD列)データをデータ行分(Start_Row から Last_Row まで)配列としてDstartに格納し、49行目は終了日の列(今回はE列)データをデータ行分だけ配列としてDendに格納しています。

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

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

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

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

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

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

フラグが0か1(本当は-1ですが)の2通りの場合は進数で表現でき、開始日・終了日の2個を判別するには桁が必要になるのです。

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


以上の考え方から、開始日を2進数の2桁目にするため、フラグを2倍にし、1桁目の終了日(フラグは1倍のまま)と足し合わせたのが図3-12になります。

図3-12

図3-12の一番右列の値を見れば、開始日に値があるのか否か、また終了日に値があるのか否かが判別できますので、これに沿って処理を仕訳けているのが、図3-11の53行目・54行目・58行目・62行目の各Caseになります。

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

これをまとめたのが図3-13です。

図3-13

①は、開始日・終了日ともデータが入っていない為、日程線は引きません。(図3-11の53行目)
②は、終了日のみのため、表示日付と終了日が合っている場合のみ線を引きます。(図3-11の55~57行目)
③は、開始日のみのため、表示日付と開始日が合っている場合のみ線を引きます。(図3-11の59~61行目)
④は、表示日付が開始日と終了日の間にある場合のみ線を引きます。(図3-11の63~65行目)

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

このようにして、図3-11の47行目でReDimした配列Dataの各要素に線(文字列)を代入していくと、図3-14の様な配列の中身になります。

図3-14

このデータを入れた配列Dataを68行目でワークシートに貼り付けます。
貼り付ける際は、貼り付けるデータ(今回は配列Data)の縦横サイズとワークシート側の縦横サイズが合っていないとエラーが発生します。
68行目では始点(左上セル)を指定してから、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
図3-15

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

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

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

72行目をフラグの集合値、73行目を調べるフラグの位置(桁位置)とします。
75行目で、ワークシート関数のDec2Binを使うことで、フラグ集合値(10進数)を2進数の文字列にすることが出来ます。(例えば、10進数の10は2進数の「1010」になる)

76行目は、その得られた2進数文字列の前に、Falseの意味であるゼロを追加しています。これは、上位フラグ(図3-17の項目8側のフラグ)がFalseであった場合、10進数に計算した時に桁落ちの様な現象が起きてしまい、2進数に戻した時に「フラグが不明」の状態になるのを防ぐためです。

図3-17

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


4.最後に

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


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

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