2020/02/28

テキストデータのスケジュール帳(入力と表示が同一画面)




1.スケジュール帳の概要

以前紹介した「テキストデータのスケジュール帳(入力と表示は別画面)」では、データの入力側(右欄)と表示側(左欄)が異なるスケジュール帳を紹介しました。入力側に記入した後、ボタンを押すことでデータが登録されるシステムでした。
しかし、例えばスケジュールを30分ズラす場合には「表示側で項目をコピー」→「入力側の新時刻にペースト」→「表示側で項目を選択し削除」と、結構な手間が必要です。Excelを使い慣れている人ならば「表示側の項目をクリックし、新時刻まで引っ張る(ドラッグ&ドロップ)」という操作をついやってしまうでしょう。
そこで今回は、前回のシステムをベースにして「入力と表示が同一画面のスケジュール帳」を考えたいと思います。

画面は、前回は別画面(図1-1の左側)であったものを、今回は同一画面(図1-1の右側)で出来るようにしています。


前回のスケジュール帳(入力と表示が別画面)

今回のスケジュール帳(入力と表示が同一画面)
図1-1

また、前回は存在した「保存」と「削除」のボタンを廃止し、スケジュール太枠内(C3:C30)でユーザが普通に操作する「記入・消す・移動・コピー」の操作を自動的に検知し、データ保存・削除をしています。
尚、データの保存シート(Sheet2)の仕様は、前回から変更させていません。

これを取扱説明書に書くとしたら、以下の通りです。
1)スケジュール太枠内に予定を記入するだけで、データ保存されます。
2)スケジュール変更で、既にある文字列を「削除」「移動」「コピー」するだけで、そのままデータ保存されます。
3)Windowsのクリップボードを使って、別な日の項目を別な日にコピー・移動することも可能です。
4)対象日を変更する際は、上のスクロールバーを動かします。(1日~1週間単位)

前回スケジュール帳「テキストデータのスケジュール帳(入力と表示は別画面)」との画面・プログラムの比較を図1-2に示します。

種類プロシージャ等役割今回での変更点
Sheet1入力画面(SC2)追加・上書きのデータを記入不要のため削除
保存ボタン入力データをまとめて保存する不要のため削除
出力画面(SC1)対象日付のデータを表示する不変
削除ボタン選択したデータを削除する不要のため削除
スクロールバー日付を変更する不変(配置は調整)
日付表示スケジュールの日付不変
Sheet2保存シート日時とスケジュールデータを保存不変
メインプログラム宣言部変数・定数宣言不要のSC2変数部分のみ削除
Sub Range_Setモジュール変数の値代入不要のSC2変数部分のみ削除
Sub Data_Save保存ボタン押下でデータ保存・再表示不要のため削除
Sub Data_Select_Delete削除ボタン押下でデータ削除・再表示不要のため削除
Sub ScrollBar1_Chanegeスクロールバー移動で日付移動・再表示データ操作時にEvents停止を追加
Sub Worksheet_Changeセルが変更された時にデータ保存・削除今回システムで追加
サブログラムFunction Search_Data日時データを探し、そのセルを返す不変
Sub Data_Paste日単位でデータを探しSC1n貼付不変
Sub Data_Delete日付+時刻データを探して行削除不変
Sub Data_Clar指示範囲の値をクリア不変
Function Last_Rowデータの最終行を算出不変
Function Row2Time行位置を時刻に変換不変
Function DateTime日付と時刻を結合不変
図1-2

これ以降、画面・プログラムの内容について説明していきます。プログラムについては全行を掲載しますが、前回システムと同一またはほぼ同一のプロシージャについては詳しい説明は省かせていただきます。詳しい内容については「テキストデータのスケジュール帳(入力と表示は別画面)」を都度参照頂くか、先に前回の説明に目を通して頂く様お願い致します。
また、サブプログラムについては全く不変のため、プログラムの行番号・図番号も不変としました。よって行番号・図番号が飛んでいる部分がある事をご了承下さい。

2.ワークシート側の細工

図2-1の通り、データはSheet2に保存されます。

図2-1

スクロールバーの設定は図2-2の通り、Max・Minを ±7(7日=1週間という意味)、LargeChange=7、SmallChange=1(1日という意味)、Value=0(バーは中立 という意味)に設定しています。


図2-2

3.シートモジュールのコード

今回のマクロは全てSheet1のシートモジュールに記載しています。

3-1.変数・定数の宣言

  1. '========== ⇩① 変数・定数宣言 ================
  2. Option Explicit          '←変数宣言の強要
  3. Const Time_S As Single = 8    '←開始時間(30分は0.5として計算)
  4. Const Time_E As Single = 21.5   '←終了時間(30分は0.5として計算)
  5. Dim SC1 As Range          '←スケジュール表(左側)の範囲
  6. 'Dim SC2 As Range          '←予約表(右側)の範囲 今回不要
  7. Dim Save_ As Range         '←スケジュールの保存先(時間列のタイトル部のセル位置)
  8. Dim Date_ As Range         '←表示日付のセル位置
  9. Dim Bar0 As Boolean        '←スクロールバーの値をゼロに戻す時に使うフラグ
  10. Private Enum SC       '←列挙型変数の宣言
  11.  Time = 1          '←日付+時刻を入れる要素
  12.  Work = 2          '←業務内容を入れる要素
  13. End Enum
図3-1

前回の入力範囲である変数SC2は今回使用しませんので、8行目はコメントアウトしています。

3-2.Range型変数への値代入

宣言部(図3-1)の7~10行目で宣言したRange型変数(定数相当)に値を代入するのが図3-2のRange_Setプロシージャです。
  1. '========== ⇩② モジュール変数(Range型)の値代入 ==================
  2. Sub Range_Set()                   '←モジュール変数(Range型)の値代入
  3.  Set SC1 = Sheets("sheet1").Range("c3:c30")    '←左欄の範囲
  4. ' Set SC2 = Sheets("sheet1").Range("d3:d30")    '←右欄の範囲 今回不要
  5.  Set Date_ = Sheets("sheet1").Range("c1")     '←日付の欄
  6.  Set Save_ = Sheets("sheet2").Range("b1")     '←データシートの日付列の先頭タイトルセル位置
  7. End Sub
図3-2

前回の入力範囲である変数SC2は今回使用しませんので、20行目はコメントアウトしています。


3-3.スケジュール画面上のセル値変更を感知してデータを処理する

図3-3の「Worksheet_Change」イベントプロシージャは、今回追加したプロシージャです。
このイベントプロシージャは、ワークシート(Sheet1に記載しているので、ここではSheet1)のセルに「何か変更があった場合」に動作するものです。反応してくれる変更内容は「データ(数式を含む)を入力」「データを削除」「編集モードにした」であり、その他の背景色、文字色、セル幅などの変更時には反応してくれませんので注意が必要です。
  1. '========== ⇩③ セル値を変更した時に動くプロシージャ ====================
  2. Private Sub Worksheet_Change(ByVal Target As Range)   '←セルを編集・削除した際にイベント発生
  3.  Dim R As Range                      '←各セルを表す変数
  4.  Dim SC_Data(1 To 2) As Variant     '←各セルの(日時,業務内容)を格納する配列
  5.  If Save_ Is Nothing Then Range_Set   '←範囲変数の読み込み
  6.  For Each R In Target                '←変更されたセル範囲(複数有)を1つ1つ調べる
  7.   If Not Intersect(R, SC1) Is Nothing Then     '←変更されセルがスケジュール帳範囲にある時
  8.    If R = "" Then                  '←セルが空だったら
  9.     Data_Delete (DateTime(Date_.Value, Row2Time(R.Row)))   '←そのデータを削除する
  10.    Else
  11.     Data_Delete (DateTime(Date_.Value, Row2Time(R.Row)))   '←そのデータを削除する
  12.     SC_Data(SC.Time) = DateTime(Date_.Value, Row2Time(R.Row))  '←日時データを配列に入れる
  13.     SC_Data(SC.work) = R.Value                   '←業務内容データを配列に入れる
  14.     Save_.Parent.Cells(Last_Row + 1, Save_.Column).Resize(1, UBound(SC_Data, 1)) _
  15.      = SC_Data     '←既存データの下に続いてデータ貼付け
  16.    End If
  17.   End If
  18.  Next R
  19. End Sub
図3-3

まず、このWorksheet_Changeイベントプロシージャは、「Target」という引数を渡してくれます。このTargetは「変更されたセル範囲」であり、単一セルの場合もありますし、複数セルの場合(エリアを範囲指定して削除する等)もあります。

26~27行目は、プロシージャ内で使用する変数の宣言です。 26行目は、「Target」で渡された範囲を調べる(30行目)工程で、範囲を1つ1つのセルに分解した後、そのセルを代入するためのRange変数です。
27行目の SC_DATA 配列は、1x2 の静的配列です。前回システムは「何項目入力されているか不明」でしたので、動的配列にしてReDimで大きさを調整していましたが、今回は「まとめて保存ボタン」が無いために1つ記入されたらすぐに処理をしていくしかありません。ですので単一セル単位で書き込みになり、データは「Time」「Work」の2項目と決まっていますので 1x2配列で固定です。
一次元の配列ですので、図3-4の様な並びになります。Sheet2の保存データ(図2-1)の並びと同じであるため、データを回転(Transpose)せずにそのまま下に追加できることになります。

  Time(1)    Work(2)  
図3-4

28行目は、以前のスケジュール帳の場合、ボタンやスクロールバーなどをユーザが操作することで動作する時に「Range_Set(Range変数への値代入)」を作動させていましたが、今回のスケジュール帳では保存・削除ボタンは無くなりました。
その代わりに「セルへの記入・削除を感知して動作」しますので、Range変数への値代入を行う「Range_Set」は、この「 Worksheet_Change」プロシージャで実行させる必要があります。
なお、変数に値が入っていない(Range変数 Is Nothing )時に実行するのは、前回と同じです。

30行目は、変更を行ったセル範囲を1つ1つのセルに分解し、Rという変数に代入しています。
31行目のIF文の中で、「Intersect(R, SC1)」は「変更セルR と スケジュール記入範囲SC1 が重なっているセル範囲」という意味ですので、重なっていれば「変更セル範囲」が返ってきます。その「変更セル範囲 Is Nothing」という式ですから、「変更セル範囲」は空ではないので「False」となります。それを「Not」で反転していますので「True」となり、最終的に「 変更セルR が スケジュール記入範囲に入っていれば IF文が成立する」ことになります。

32行目で、その 変更セルRが「①空欄」なのか「②空欄ではない」なのかを調べています。
変更セルRが「①空欄」ということは「削除された、移動された」ということですので、そのデータを削除する必要があります。表示日付(Date_.Value)と時刻(Row2Time(R.Row))を加算して日時データにし、その日時データを引数として渡した Data_Delete でSheet2の保存データから削除しています。
一方、変更セルRが「②空欄ではない」ということは「何か新しく記入された、上書きされた、移動してきた、コピペされた」ということですので、データを新たに保存する(39~40行目)必要があります。しかし、「上書きされた」=「元のデータが存在する」可能性があるので、同じ日時のデータを作らないために、まずは「元データを削除」する事が必要です。そのため新データを追加する前に、35行目でデータ削除しています。
(元が空欄のセルに新規に記入した場合は、削除するものが無いので「Data_Delete」プロシージャは何もしない事になります。)

37~38行目で、Sheet2の保存データに追加するデータ配列を作成(配列への代入)をしています。
37行目は、まず表示日付(Date_.Value)と行位置から計算した時刻(Row2Time(R.Row))を DateTime 関数で加算し、その日時データをSC_Data配列の要素1の「SC_Data(SC.Time)」に代入しています。尚、「SC.Time」とは、図3-1の13~16行目のEnumで列挙型変数の設定をしていますので、SC.Time は要素1 と読み替えられます。
また38行目はセルR の値(セルに記入された文字列等)をSC_Data配列の要素2の「SC_Data(SC.Work)」に代入しています。

39行目は「Save_.Parent.Cells(Last_Row + 1, Save_.Column).Resize(1, UBound(SC_Data, 1))」で、データを追加する場所を計算しています。先頭から説明すると、「Save_.Parent」でシート先(Sheet2)を、「Cells(Last_Row + 1, Save_.Column)」で保存データの最終行の1つ下を示し、「Resize(1, UBound(SC_Data, 1))」で、貼付けデータサイズと同等の横サイズを確保しています。
この貼付け先に40行目で、先ほどのセルR の日時データ+業務データを格納したSC_Data配列を貼り付けています。
これでSheet2の保存データにデータが追加されたことになります。

なお、「DateTime(Date_.Value, Row2Time(R.Row))」と同じような式が3回出てきますので、図3-3は図3-5の様に書くことも出来ます。(変数は1つ増えますが、スッキリと可読性が良くなり、また計算が少なくなるので処理速度も上がるはずです)

  1. '========== ⇩③ セル値を変更した時に動くプロシージャ ==================
  2. Private Sub Worksheet_Change(ByVal Target As Range)   '←セルを編集・削除した際にイベント発生
  3.  Dim R As Range                      '←各セルを表す変数
  4.  Dim SC_Data(1 To 2) As Variant     '←各セルの(日時,業務内容)を格納する配列
  5.  If Save_ Is Nothing Then Range_Set   '←範囲変数の読み込み
  6.  Dim DT As Double             '←日時データであるDateTimeを入れる変数
  7.  For Each R In Target                '←変更されたセル範囲(複数有)を1つ1つ調べる
  8.   If Not Intersect(R, SC1) Is Nothing Then     '←変更されセルがスケジュール帳範囲にある時
  9.   DT = DateTime(Date_.Value, Row2Time(R.Row))    '←DateTimeデータを変数に代入
  10.    If R = "" Then                  '←セルが空だったら
  11.     Data_Delete (DT)            '←そのデータを削除する
  12.    Else
  13.     Data_Delete (DT)             '←そのデータを削除する
  14.     SC_Data(SC.Time) = DT         '←日時データを配列に入れる
  15.     SC_Data(SC.work) = R.Value           '←業務内容データを配列に入れる
  16.     Save_.Parent.Cells(Last_Row + 1, Save_.Column). Resize(1, UBound(SC_Data, 1)) _
  17.      = SC_Data     '←既存データの下に続いてデータ貼付け
  18.    End If
  19.   End If
  20.  Next R
  21. End Sub
図3-5

また、セルRの値が空でも空でなくても「Data_Delete」は必ず実行しますので、IF文の前に「Data_Delete」を集約する図3-6の方法でもOKです。(プログラムの流れが読みにくくなると思い、図3-3の方法で説明をしました)

  1. '========== ⇩③ セル値を変更した時に動くプロシージャ ===================
  2. Private Sub Worksheet_Change(ByVal Target As Range)   '←セルを編集・削除した際にイベント発生
  3.  Dim R As Range                      '←各セルを表す変数
  4.  Dim SC_Data(1 To 2) As Variant     '←各セルの(日時,業務内容)を格納する配列
  5.  If Save_ Is Nothing Then Range_Set   '←範囲変数の読み込み
  6.  Dim DT As Double             '←日時データであるDateTimeを入れる変数
  7.  For Each R In Target                '←変更されたセル範囲(複数有)を1つ1つ調べる
  8.   If Not Intersect(R, SC1) Is Nothing Then     '←変更されセルがスケジュール帳範囲にある時
  9.   DT = DateTime(Date_.Value, Row2Time(R.Row))    '←DateTimeデータを変数に代入
  10.    Data_Delete (DT)                '←まずは、そのデータを削除する
  11.    If Not R = "" Then                '←セルが空で無い時だけ
  12.     SC_Data(SC.Time) = DT               '←日時データを配列に入れる
  13.     SC_Data(SC.work) = R.Value             '←業務内容データを配列に入れる
  14.     Save_.Parent.Cells(Last_Row + 1, Save_.Column). Resize(1, UBound(SC_Data, 1)) _
  15.      = SC_Data     '←既存データの下に続いてデータ貼付け
  16.    End If
  17.   End If
  18.  Next R
  19. End Sub
図3-6

3-4.「スクロールバー」操作時の動作

上に配置してある「スクロールバー」を操作(値を変更)した時の登録マクロは、以下(図3-9)です。
  1. '========== ⇩⑤ スクロールバーを動かした時に動くプロシージャ ================
  2. Private Sub ScrollBar1_Change()      '←スクロールバーを動かした時に動くプロシージャ
  3.  If Save_ Is Nothing Then Range_Set   '←範囲変数が未設定の時(最初の操作時)は読み込む
  4.  If Bar0 = True Then Exit Sub      '←マクロでスクロールバー値を動かした時は抜け出す
  5.  Date_ = ScrollBar1.Value + Date_.Value   '←左上の日付にスクロールバー値を足して、新たな日付にする
  6.  Application.EnableEvents = False       '←データ消去・表示時に保存データを保護する為、イベントSTOP(今回追加)
  7.  Call Data_Clear(SC1)        '←左欄の値をクリア
  8.  Call Data_Paste(Date_.Value)   '←新たな日付でデータを探して、左欄に貼る
  9.  Application.EnableEvents = True       '←データ消去・表示完了後に、イベント再開(今回追加)
  10.  Bar0 = True            '←フラグを立てて、再画面更新をしない様にする
  11.   ScrollBar1.Value = 0      '←スクロールバー値を変更(ゼロに戻し、中立位置にする)
  12.  Bar0 = False
  13. End Sub
図3-9

71行目は、現在の日付(変数 Date_.Value )にスクロールバーで変更した値(Value値)を足した値を、新たな日付としてRange変数 Date_ に代入し、日付が新しくなった後で73行目でスケジュール欄(SC1)の値をクリアし、74行目で新たな日付のデータを検索・貼付けさせています。

ここで一つ問題が発生します。データをクリア(73行目)=「データ消去操作」を図3-3のイベントプロシージャが受け取ってしまうと、「ユーザがデータを削除した」と勘違いしたことになり、新日付のデータを削除されてしまいます。 ちなみに、73行目では範囲SC1を全消去していますので、全行(C3:C30)の28データ削除プロセスが動きます(データがある行だけではありません)。
これを防止するために、データをクリアする前(72行目)に「Application.EnableEvents = False」でイベント発生を停止させています。

74行目についてですが、「イベント発生停止」が無い状態では、前行73行目で新日付のデータが全て消されていますので、74行目のデータ貼付けをしようとしても、貼り付けるものが無く真っ白の画面になります。
また、72行目で「イベント発生停止」させたとしても、貼り付ける前(74行目と73行目の間)で「イベント停止解除」をしてしまうと、貼付けプロセスを「ユーザのデータ書き換え行為」と勘違いして保存データの更新をしてしまいます。(表面的には正常に見えますが、裏でデータの無駄な削除・追加をしていることになります)
ということで、75行目に「Application.EnableEvents = True」を記載し、イベント発生を復活させています。

76~78行目は、変数Bar0のフラグをTrueにした後、スクロールバーのValue値をゼロにしています。このことで「ScrollBar1_Change」が再度動いて画面再表示してしまう行為を69行目で防止しています。
バーを中立にしたら変数Bar0を規定値のFalseに戻します。


3-5.サブプログラム

以下は、メインプログラムの中から呼び出されるプロシージャです。7つのSubプロシージャ、Functionプロシージャを今回使用しています。

図3-10は「保存シートの中から目的の日時のデータを探す」関数です。見つかったらそのデータのセル(Range型)を、見つからなかったらNothingを返します。
  1. '========== ⇩⑥ 日時のデータを探し、そのセルを返す関数 =================
  2. Function Search_Data(DateTime As Double) As Range    '←日時のデータを探し、そのセルを返す
  3.  Dim Search_Range As Range           '←データ検索範囲
  4.  Dim No As Double               '←探し出したデータの検索範囲内での相対行位置
  5.  Set Search_Range = Save_.Resize(Last_Row - 1, 1).Offset(1, 0)   '←検索範囲を計算
  6.  On Error Resume Next                      '←データが無かった時には無視する
  7.   No = WorksheetFunction.Match(DateTime, Search_Range, 0)  '←検索範囲で日時データを探す
  8.   If Err = 0 Then                       '←データが有った時
  9.    Set Search_Data = Save_.Offset(No, 0)         '←そのデータの場所を返す
  10.   Else                           '←データが無かった時
  11.    Set Search_Data = Nothing                '←Nothingを返す
  12.   End If
  13.  On Error GoTo 0
  14. End Function
図3-10


図3-13は「保存シートの中から目的の日付のデータを探して貼り付ける」プロシージャです。1行ずつ(30分ずつ)ずらしながら、該当するデータが存在すれば左欄に貼り付けていきます。該当するデータがなければ、何もしません。
  1. '========== ⇩⑦ 日単位でデータを探して左欄に貼り付けるプロシージャ =============
  2. Sub Data_Paste(D As Date)        '←日単位でデータを探してスケジュール欄に貼り付けるプロシージャ
  3.  Dim T As Single
  4.  Dim R As Long
  5.  For T = Time_S To Time_E Step 0.5  '←0.5(30分)単位で開始(Time_S)から終了(Time_E)までを調べる
  6.   R = R + 1
  7.   On Error Resume Next         '←探してデータが無かった時は無視する
  8.    SC1(R) = Search_Data(DateTime(D, T)). Offset(0, 1).Value  '←日時データがあったらその横の業務内容を貼り付ける
  9.   On Error GoTo 0
  10.  Next T
  11. End Sub
図3-13


図3-14の「Data_Delete」プロシージャは引数に日時データを渡し、保存データ内に該当データがあれば削除する機能です。
  1. '========== ⇩⑧ 日付+時刻のデータを探して行削除するマクロ ===============
  2. Sub Data_Delete(DateTime As Double)
  3.  On Error Resume Next             '←データが無かった時はエラーが発生する為、無視する
  4.   Search_Data(DateTime).EntireRow.Delete   '←日付+時刻のデータを探して行削除
  5.  On Error GoTo 0
  6. End Sub
図3-14


図3-15の「Data_Clear」プロシージャは、引数にセル範囲を渡すとその範囲のデータをクリアする機能です。
  1. '========== ⇩⑨ 範囲Rの値をクリアするマクロ ==================
  2. Sub Data_Clear(R As Range)
  3.  R.Value = ""           '←範囲Rの値をクリア
  4. End Sub
図3-15


図3-16の「Last_Row」関数は、検索場所を「保存データ(Sheet2 のB列)」に固定した、最終行の検索プロシージャです。
  1. '========== ⇩⑩ データの最終行を算出する関数 ===============
  2. Function Last_Row()       '←データシート(Sheet2)のデータの最終行を算出
  3.  Last_Row = Save_.Parent.Cells(Rows.Count, Save_.Column).End(xlUp).Row
  4. End Function
図3-16


図3-17は「指定した行位置を時刻に変換」する関数です。
  1. '========== ⇩⑪ 行位置を時刻に変換する関数 =====================
  2. Function Row2Time(R As Long) As Single      '←行位置を時刻に変換
  3.  Row2Time = (R + (Time_S * 2 - SC1.Row)) / 2  '←左列の時刻との関係を数式にしている
  4. End Function
図3-17


図3-19の「DateTime」関数は、日付と時刻を引数で与えると、日付+時刻のDouble型の値を返します。
  1. '========== ⇩⑫ 日付と時刻を結合する関数 =====================
  2. Function DateTime(D As Date, T As Single) As Double  '←日付と時刻(例:9:30 → 9.5)
  3.  DateTime = D + T / 24                   '←時刻を含めた日付値にする
  4. End Function
図3-19


4.最後に

今回は、Worksheet_Changeイベントを利用することで「入力後にボタンを押す」という行為が必要なくなり、「プログラムを意識しないツール」「普通の操作が通じるツール」に少し近づいたと思います。また前回スケジュール帳と比べてみても、ちょっと修正するレベルで使い勝手が変わることもお分かりいただけたと思います。
文句を言われながら使われているシステム・今は使われなくなったシステムも、うまく手を入れてみると生まれ変わるかもしれませんね。



テキストデータのスケジュール帳2 (it-019.xlsm)

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