2020/02/26

テキストデータのスケジュール帳（入力と出力は別画面）




１．スケジュール帳の概要

色々なサイトを覗いていると「スケジュール帳を作りたい」という要望が結構ありそうです。内容としては、複数人の日々スケジュールデータを人別に１週間まとめたり、複数の人のを横並びにまとめたりといったものです。
今回は複数データのまとめの一歩手前の、個人のスケジュール帳を紹介します。以前紹介した「図形も貼り付けられるスケジュール帳」と似てはいますが、今回は文字情報だけのスケジュール帳としています。というのも、文字だけであれば「複数人のスケジュールをまとめる」事も容易と考えたからです。

画面は図１－１の様に考えました。縦に時刻、太枠内の左欄に登録済スケジュールが表示され、右欄で追加・修正をします。

図１－１

操作としては、以下の通りです。
１）右欄に予定を書いた後「保存」ボタンを押す事でデータが保存され、その日のスケジュールが左欄に反映される。
　　（今回の仕様では、ユーザーが記入するのは右欄のみ）
２）左欄と同時刻の行（右欄）にデータ記入すれば上書きとなり、空欄の行に記入すれば追加となる。
３）不要になった予定は、左欄でセル選択（複数セルもOK）した後「削除」ボタンを押す事でデータが削除される。
４）対象日を変更する際は、上のスクロールバーを動かす。（１日～１週間単位で動かせます）

２．ワークシート側の細工

図２－１の通り、データはSheet2に保存され、１行目はタイトル行、実データは２行目からになります。Ｂ列（DateTime）が日付＋時刻のデータ、Ｃ列（Work）が業務内容です。特記するとすれば、Ｂ列は日付っぽい数字ですがデータ型はDoubleとしています。Data型と同じ8バイトですので、書式で日付を選べば日付表示になりますが、あえてDouble型の数値として保存しています。

図２－１

記入側（Sheet1）の２行目には２つのボタンを配置しています。右の「保存」ボタンには「Data_Save」マクロを、左の「削除」ボタンには「Data_Select_Delete」マクロを登録しています。
その上のスクロールバーの設定は、図２－２の通り、Max･Minを ±7（７日＝１週間という意味）、LargeChange=7、SmallChange＝1（１日という意味）、Value＝0（バーは中立　という意味）に設定しています。

図２－２

３．シートモジュールのコード

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

３－１．変数・定数の宣言

  1. '==========　⇩①　変数・定数宣言　 ========================
  2. Option Explicit　　　　　　　　　 '←変数宣言の強要
  4. Const Time_S As Single = 8　　　 '←開始時間（30分は0.5として計算）
  5. Const Time_E As Single = 21.5　　 '←終了時間（30分は0.5として計算）
  7. Dim SC1 As Range　　　　　　　　　 '←スケジュール表（左側）の範囲
  8. Dim SC2 As Range　　　　　　　　　 '←予約表（右側）の範囲
  9. Dim Save_ As Range　　　　　　　　 '←ｽｹｼﾞｭｰﾙの保存先（時間列のﾀｲﾄﾙ部のセル位置）
  10. Dim Date_ As Range　　　　　　　　 '←表示日付のセル位置
  11. Dim Bar0 As Boolean　　　　　　　 '←ｽｸﾛｰﾙﾊﾞｰの値をｾﾞﾛに戻す時に使うﾌﾗｸﾞ
  13. Private Enum SC　　　　　　 '←列挙型変数の宣言
  14. 　Time = 1　　　　　　　　　 '←日付＋時刻を入れる要素
  15. 　Work = 2　　　　　　　　　 '←業務内容を入れる要素
  16. End Enum
図３－１

まず、２行目の「Option Explicit」は、変数・定数の宣言をしていないとエラーが出力されるものです。記述ミスを減らす効果が大きいものですが、試行錯誤でコードを組み立てる時にはちょっと鬱陶しい感じがしないでもありません。
しかし、今回はこの恩恵に預かりました。図２－１のところでも書きましたが、日付＋時刻の値をSheet2のＢ列に保存していますが、当初はこのデータをDate型で保存したのです。すると検索時にどうしても上手く拾えません。拾えない理由は「セル上に保存されているデータ型の桁数」と「メモリー上の検索値のデータ型の桁数」が内部的に違うからではないか、ということまでは掴みました。（小数点桁数の少ない時刻は拾えるので）
ということで、きちんとDouble型で保存・検索をすると上手くいきましたので、この変数宣言強要は是非お勧めいたします。

４～５行目は、スケジュール帳の開始時刻（Time_S）と終了時刻（Time_E）の設定です。開始時刻と記入欄の縦サイズ（７行目の変数SC1）、時間の間隔（今回は30分）が分かれば終了時刻は計算で求められますが、分かりやすく両方設けました。尚、全ての値の変数・定数の間に整合性が取れていないと必ず不具合が発生します。いらぬ心配とテストの大変さを考えると、数式が複雑にはなりますが、出来れば一意で決まる様にした方がBetterです。

７～１０行目は Range 型の変数宣言で、実質は定数です。スケジュールを表示する画面（ SC1 ）、スケジュールを入力・修正する画面（ SC2 ）、保存先（ Save_ ）、表示日付セル（ Date_ ）の４範囲を図３－２の１９～２２行目で代入しています。
１１行目の変数 Bar0 については、図３－９で詳細説明します。

１３～１６行目は、「列挙型変数」の設定です。図３－４でデータを追加・修正する際に、一時保管用の SC_Data と言う配列を使用していますが、その味気ない数字のインデックス番号の代わりに分かりやすい名前を割り当てています。
また、図３－２のように「定数を数値ではなく自分の分かり易い単語で選択できる」ことにも良く使われます。
  1. '==========　Enum の使用例　 ========================
  2. Enum FontColor　　　　　　　　 '←列挙型を設定
  3. 　Black = 1　　　　　　　　 '←各色の色番号に単語を割り当てる
  4. 　Red = 3
  5. 　Green = 10
  6. 　Blue = 6
  7. End Enum
  9. Sub Test()
  10. 　ActiveCell.Font.ColorIndex = FontColor.Green　　　　 '←色番号を単語で設定
  11. End Sub
図３－２

その他「列挙型変数」を使うメリットとして、インテリセンス（自動入力補完機能）が使用できるところです。図３－２の例で言えば、図３－２の１０行目で「・・・= FontColor.」と列挙型の名前まで入力すると、そのメンバー（Black,Red,･･･）が自動表示され選択するだけなので、効率的でありタイプミスが少なくなります。
今回（図３－１）は、「日時 Time」＝１、「業務 Work」＝２ の２つを列挙型にしてあります。

３－２．Range型変数への値代入

宣言部（図３－１）の７～１０行目で宣言したRange型変数（定数相当）に値を代入するのが図３－３の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
図３－３

今回のシステムでは、モジュール変数（Range変数）をどのプロシージャでも使いますので、マクロを動かす前までにこのRange変数への値代入（＝Range_Setプロシージャの実行）が必要です。
通常は、必ず実行されるブックモジュール（＝ThisWorkbook）のWorkbook_Openで記述するのですが、一方でシート上のボタン等にマクロを登録する必要もあります。すると、シートとブックの間でのやり取りが発生するため Public変数やPublicプロシージャを用いる必要が出てきてしまいます。変数もプロシージャも出来るだけ狭い範囲で使いたいので、今回はマクロを初めて動かすタイミング（ボタンが押された、スクロールバーを動かした）でモジュール変数への代入を実行する事としました。
そのため、このRange_Setプロシージャは、図３－４、図３－７、図３－９のプロシージャの内、何れかから実行されます。

尚、変数「Save_」は、今回は「先頭タイトルのセル位置」としました。当初「データが始まるセル（B2セル）」に設定をして試行していたのですが、データを削除する際に「B2セルの行を削除すると、Save_変数に代入されている値も削除されてしまう」ことが分かりました。値が削除されると＝Nothing となり、思った通りの動作にならなかったのです。その為、変数にはタイトル行を代入するようにしました。

３－３.「保存」ボタン押下時の動作

右欄の上にある「保存」ボタン押下に登録したマクロは、以下（図３－４）です。
  1. '==========　⇩③　右欄の上の｢保存｣ﾎﾞﾀﾝを押した時のﾏｸﾛ　 ====================
  2. Sub Data_Save() 　　　　　　　　　　　　　　　 '←右欄の上の｢保存｣ﾎﾞﾀﾝを押した時のﾏｸﾛ
  3. Dim R As Range 　　　　　　　　　　　　　　 '←右欄の各セルを表す変数
  4. Dim SC_Data() As Variant 　　　　　　　　 '←右欄に記入されたﾃﾞｰﾀを入れる配列
  5. Dim i As Long 　　　　　　　　　　　　　　 '←ﾃﾞｰﾀの個数
  7. If Save_ Is Nothing Then Range_Set 　　 '←範囲変数が未設定の時(最初の操作時)は読み込む
  9. 　For Each R In SC2 　　　　　　　　　　 '←右欄のセルを一つずつ調べる
  10. 　　If Not R.Value = "" Then 　　　　　 '←セルが空で無かったら
  11. 　　　i = i + 1
  12. 　　　ReDim Preserve SC_Data(1 To 2, 1 To i) 　　　　　 '←配列のサイズを大きくする
  13. 　　　SC_Data(SC.Time, i) = DateTime(Date_.Value, Row2Time(R.Row)) 　　 '←日時ﾃﾞｰﾀを代入
  14. 　　　SC_Data(SC.Work, i) = R.Value 　　　 '←業務内容を代入
  16. 　　　Data_Delete (SC_Data(SC.Time, i)) 　　 '←同じ日時ﾃﾞｰﾀがあれば削除
  18. 　　End If
  19. 　Next R
  20. 　On Error Resume Next 　　　　　　　　 '←右欄が全て空欄だったらｴﾗｰ発生の為､無視する
  21. 　　Save_.Parent.Cells(Last_Row + 1, Save_.Column).Resize(UBound(SC_Data, 2), UBound(SC_Data, 1)) _
  22. 　　　= Application.WorksheetFunction. Transpose(SC_Data) 　　　 '←既存ﾃﾞｰﾀの下に続いてﾃﾞｰﾀ貼付け
  23. 　On Error GoTo 0
  25. 　Call Data_Clear(SC1) 　　　　　　 '←左欄のﾃﾞｰﾀをクリア
  26. 　Call Data_Paste(Date_.Value) 　　 '←指定日のﾃﾞｰﾀを検索し、左欄に貼付け
  27. 　Call Data_Clear(SC2) 　　　　　　　 '←右欄のﾃﾞｰﾀをクリア
  28. End Sub
図３－４

２６～２８行目は、プロシージャ内で使用する変数の宣言です。
変数 R は、３２行目で右欄（ SC2 ）の各セルを For Each Next で取り出していますが、その１つ１つのセルをRに代入しています。
変数 SC_Data は、右欄（ SC2 ）に記入された文字列とその日時を代入する配列です。記入されたセルの数により配列のサイズも変わるため、動的配列にし、その大きさは３５行目のReDimで変更しています。
変数 i は、カウント用変数ですが、右欄（ SC2 ）の中で「記入されたセル数」を数える役目をはたします。

３０行目は、図３－３の「モジュール変数にセル範囲を代入」するプロシージャを動かすコードです。スクロールバー・２つのボタンの内、最初に操作した場所でRange_Setプロシージャを動かします。
コードは「 If Save_ Is Nothing Then Range_Set 」つまり「変数Save_が空の時に実行」となっていますが、図３－３では４つの変数に値を代入していますので、どの変数でもOKです。（３－２項でも書きましたが、当初Save_変数は削除される可能性があった為、ここではSave_変数を確認変数にしています）

３２行目の「For Each R In SC2」で右欄から１つずつセルを取り出し、３３行目の「If Not R.Value = "" Then」で文字が入っていたら、３４～３９行目を実行します。
まず３５行目で、一時保存用配列（ SC_Data ）のサイズを１つ大きくします。動的配列で要素数を変更できるのは「最後の次元」に限られます。今回は２次元ですので、 「SC_Data ( 変更出来ない次元 , 変更出来る次元 )」 となります。普通のイメージでは SC_Data ( 行 , 列 )　ですので、増えていく「行」が増やせないのには抵抗がありますが仕方ありません。行ｘ列を反転した形で配列に収めていくことになります。

３６行目では、「日付＋時刻の数値をDouble型」で配列SC_Dataの１つ目に代入しています。
日付＋時刻の値は、別関数 DateTime の引数として「日付」と「時刻」を別々に渡すと取得できます（図３－１９）。日付はRange変数 Date_ の値を使えば良いのですが、この段階では時刻は不明です。ですので時刻を求めるために、Row2Time 関数に引数として R の行位置（R.row）を渡して時刻を取得しています（図３－１７）。
３７行目は、セルRに入っている文字列ですので、R.Value を配列SC_Dataの２つ目に代入するだけでOKです

３９行目は「Data_Delete (SC_Data(SC.Time, i))」となっています。Data_Delete プロシージャの内容については図３－１４のところで詳しく説明しますが、機能としては「日付＋時刻のデータを与えると保存データの中を探し、存在すれば行削除する」ものです。
配列 SC_Data に代入したデータは、最後は保存データとして保存シート（Sheet2）に貼るものですので、同じ日付＋時刻のものが存在したら整合性が取れないことになります。ですので、Data_Delete プロシージャを使って、３６行目で代入した日付＋時刻を検索値として、保存データを消しているのです。つまり「古いデータを削除　＋　新しいデータを追加　＝　データを上書き」している事になるのです。

４４～４５行目は、４４行目の最後が「半角スペース＋アンダースコア( _ )」となっていますので、２行に渡っていますが一つの式です。
この段階では For Each Next を抜けた後ですので、右欄に記入してある文字列は全て配列 SC_Data に代入されています。

まずは、代入する側である「＝　の右辺」を見てみましょう。「Application.WorksheetFunction.Transpose(SC_Data)」となっていますが、「 Transpose 」というのはワークシート関数「 TRANSPOSE 」と同じ機能を持つ「WorksheetFunctionオブジェクトのTransposeメソッド」です。
Transpose の機能は「配列の縦方向と横方向のセル範囲の変換」です。例えば今回のプログラムで配列 SC_Data に３行分のデータが入った場合を考えてみます。
配列 SC_Data にデータが入った時の様子を覗いてみると、図３－５の左側の様に、配列は横に長い形状になっています。これは３５行目で説明した通り、ReDim は「配列の最後の次元しか大きくできない」ので２次元だと横に延びていく事になります。
Sheet2の保存データは、図２－１のように「横方向に「日付＋時刻」と「業務」、縦方向にデータが並んでいる」ので、このままの状態では貼付けられません。
そこで「 Transpose 」メソッドで処理することで、縦横が入れ替わった配列（ 図３－５の右側の状態）にすることが出来、保存データとして貼り付けられる事になるのです。

transpose関数での配列の列・行の入れ替わり
図３－５

次に、代入される側である「＝　の左辺」です。「 Save_.Parent.Cells(Last_Row + 1, Save_.Column).Resize(UBound(SC_Data, 2), UBound(SC_Data, 1)) 」と長い式になっていますが、先頭の方から見ていきます。図３－６と見比べながら読み進めて下さい

図３－６

まず「 Save_.Parent」です。モジュール変数 Save_ には、図３－３の２２行目で「Sheets("sheet2").Range("b1")」というセル範囲が代入されていますので、その親（Parent）はワークシートである「Sheets("sheet2")」という事になります。
その次の「.Cells(Last_Row + 1, Save_.Column)」は、Cells(3,2)がＢ３セルを指すのと同じようにカッコ内は「行・列」を示しています。つまり「行は、Last_Row + 1」「列は、Save_.Column」です。
Last_Row は、自作関数（図３－１６）で保存シート（Sheet2）の保存データの最終行を返してきます。ですのでLast_Row + 1 は「データの最終行の次につなげて」という意味になります。
列側の Save_.Column のSave_ は「Sheets("sheet2").Range("b1")」ですので、.column でＢ列、つまり「2」という数値になります。
よって、「Save_.Parent.Cells(Last_Row + 1, Save_.Column)」は、「保存データの下に続く位置のＢ列のセル位置」を指します。

その後の「.Resize(UBound(SC_Data, 2), UBound(SC_Data, 1))」ですが、まず Resize は「（セル範囲）.Resize（新しい範囲の行数 , 新しい範囲の列数）」の様に指定し、（セル範囲）を新しい行数・列数に変更した範囲にします。
ではその新しい範囲の行数は「UBound(SC_Data, 2)」で与えていますので、データを入れたSC_Data配列（図３－５の左側）の２次元目（伸ばしていける側）のサイズとなります。図３－５では３つデータが入っているので「UBound(SC_Data, 2)＝3」となります。
新しい範囲の列数の方は「UBound(SC_Data, 1)」ですので、データを入れたSC_Data配列（図３－５の左側）の１次元目（固定側）のサイズ となり、Time　と　Work で固定されていて「UBound(SC_Data, 1)＝2」となります。固定値の「２」を入れておいても良いのですが、配列項目を増やしたりした際には、ここのコードを探し出して修正しなければならないため、出来るだけ自動的に値が修正されるようにすべきと考えています。
つまり、「 Save_.Parent.Cells(Last_Row + 1, Save_.Column).Resize(UBound(SC_Data, 2), UBound(SC_Data, 1)) 」で、貼り付けるデータ（＝の右辺）と同じサイズで指示したことになるのです。尚、貼り付ける側と貼り付けられる側でサイズが合ってないとエラーが発生します。

ということで、４４～４５行目で既存の保存データの後ろに続けて、新しいデータが貼り付くことになります。

ただし、右欄（SC2）が全て空欄（＝記入をせずに「保存」ボタンを押した）だった場合は、配列SC_Dataの中にデータが一つも入らず動的配列を宣言したままの状態なので要素数が決まっていません（要素数＝ゼロ　と言う訳では無い）。ですのでエラーが発生しますので、４３行目で「On Error Resume Next」でエラーが発生しても無視させています。

３－４.「削除」ボタン押下時の動作

左欄の上にある「削除」ボタンを押下に登録したマクロは、以下（図３－７）です。
  1. '==========　⇩④　左欄で｢削除｣ﾎﾞﾀﾝを押した時のﾏｸﾛ　 =============
  2. Sub Data_Select_Delete()　　　　　　　　 '←左欄で｢削除｣ﾎﾞﾀﾝを押した時のﾏｸﾛ
  3. 　Dim R As Range　　　　　　　　　　　　 '←選択範囲の各セルを表す変数
  4. 　If Save_ Is Nothing Then Range_Set　　 '←範囲変数が未設定の時(最初の操作時)は読み込む
  6. 　For Each R In Selection　　　　　　　 '←選択範囲の各ｾﾙを1つずつ調べる
  7. 　　If Not Intersect(R, SC1) Is Nothing Then　　 '←そのｾﾙが左欄だったら
  8. 　　　Data_Delete (DateTime(Date_.Value, Row2Time(R.Row)))　　 '←そのﾃﾞｰﾀを削除する
  9. 　　End If
  10. 　Next R
  12. 　Call Data_Clear(SC1) 　　　　　　 '←左欄のﾃﾞｰﾀをクリア
  13. 　Call Data_Paste(Date_.Value) 　　 '←指定日のﾃﾞｰﾀを検索し、左欄に貼付け
  14. End Sub
図３－７

５４行目の変数 R は、５７行目で「現在選択している範囲」の各セルを For Each Next で取り出していますが、その１つ１つのセルをRに代入しています。
５５行目は、図３－４の３０行目と同じで、図３－３の「モジュール変数にセル範囲を代入」するプロシージャを動かすコードです。スクロールバー・２つのボタンの内、最初に操作した場所でRange_Setプロシージャを動かします。

５７～６１行目は、「左欄の選択しているセルのデータを削除」する部分です。
まず５７行目は「For Each R In Selection」となっています。「Selection」は、ユーザが選択しているセル（複数でもOK）を表しますので、そのセルを１つ１つ調べていきます。
５８行目の「If Not Intersect(R, SC1) Is Nothing Then」ですが、Intersect メソッドは引数に指定した２つの範囲を見比べて、その重なっている範囲を返してくるものです。引数１のRは選択したセル・引数２のSC1は左欄の範囲ですので、もし重なっていれば図３－８の如く「左欄のどこかのセル範囲」が返ってきます。反対に重なっていなければNothingとなります。

図３－８

その「Intersect(R, SC1)」の結果を「Is Nothing」で比較していますので、重なっている場合は図３－８の②の通りFalseになり、それを「Not」で反転している為に、最終的には③のTrueになります。つまり重なっている（＝選択したセルが左欄である）場合にIF文が成立します。

IF文が成立（＝選択したセルが左欄内に存在）すると５９行目が実施され、選択したデータが削除されます。削除する「Data_Delete（日時）」プロシージャの中身については図３－１４で説明しますが、その引数である日時は「DateTime(Date_.Value, Row2Time(R.Row)」で与えています。これは図３－４の３６行目の右辺と全く同じです。

データを削除したら画面も変更しなければいけません。５９行目で保存データを削除した後で「 R.value = "" 」の様に左欄の対象セルの値を削除しても良いですし、図３－７の様に６３行目で一旦左欄を全クリアし、６４行目で再度日付で検索して貼り付けても良いと思います。
今回「一旦全クリアした後、再検索・貼り付け」という面倒な方を選んだのは、拡張性を考えたからです。このシステムを「セルや文字に色をつけたりできる仕様」に改造した際は、不要になったセルをクリアするにも単純に「 R . value = "" 」だけという訳にはいきません。別プロシージャにしていれば、Data_Clear プロシージャや Data_Paste プロシージャを改造するだけで、この「Sub Data_Select_Delete()」はそのまま使用できるからです。
尚、セルの色などを保存するには、図３－４の３６～３７行目のSC_Data配列代入時に文字情報・日時情報と共に色情報などを文字列・数字データとして取り込み、保存データに書き込む方法が良いかと思います。（まだトライはしていませんが）

３－５.「スクロールバー」操作時の動作

最も上にある「スクロールバー」を操作（値を変更）した時の登録マクロは、以下（図３－９）です。
  1. '==========　⇩⑤　ｽｸﾛｰﾙﾊﾞｰを動かした時に動くﾌﾟﾛｼｰｼﾞｬ　 ===================
  2. Private Sub ScrollBar1_Change() 　　　　　 '←ｽｸﾛｰﾙﾊﾞｰを動かした時に動くﾌﾟﾛｼｰｼﾞｬ
  3. 　If Save_ Is Nothing Then Range_Set 　　 '←範囲変数が未設定の時(最初の操作時)は読み込む
  4. 　If Bar0 = True Then Exit Sub 　　　　　 '←ﾏｸﾛでｽｸﾛｰﾙﾊﾞｰ値を動かした時は抜け出す
  6. 　Date_ = ScrollBar1.Value + Date_.Value 　　 '←左上の日付にｽｸﾛｰﾙﾊﾞｰ値を足して､新たな日付にする
  8. 　Call Data_Clear(SC1) 　　　　　　　 '←左欄の値をクリア
  9. 　Call Data_Paste(Date_.Value) 　　 '←新たな日付でﾃﾞｰﾀを探して､左欄に貼る
  11. 　Bar0 = True 　　　　　　　　　　　 '←ﾌﾗｸﾞを立てて､再画面更新をしない様にする
  12. 　　ScrollBar1.Value = 0 　　　　　 '←ｽｸﾛｰﾙﾊﾞｰ値を変更（ｾﾞﾛに戻し､中立位置にする）
  13. 　Bar0 = False
  14. End Sub
図３－９

６８行目は、図３－４の３０行目や図３－６の５５行目と同じく、図３－３の「モジュール変数にセル範囲を代入」するプロシージャを動かすコードです。スクロールバー・２つのボタンの内、最初に操作した場所でRange_Setプロシージャを動かします。
６９行目は、モジュール変数 Bar0 の値がTrue の時には、このプロシージャを抜け出す　というものです。Bar0変数は通常はFalse（変数宣言した直後はFalse、７８行目を通過したらFalse になる）ですので６９行目は実行されませんが、７７行目の「プログラム側からスクロールバーを中立位置に戻す処理をする（ Value = 0 ）」時だけ、動作するようにしています。 スクロールバーを中立位置に戻す理由は、ユーザが手動で動かしたバーの位置のままだと次の操作に支障が出るからです。

支障の例としては、今回の設定ではスクロールバーのMax値を「７」にしてあります（これは「スケジュール帳は毎日使うものだから、ページを飛ばすとしても次週（７日後）だろう」という思惑から７に設定しています）が、ユーザが次週のスケジュールを確認した後で、またその翌週を見たくても、既にMax値に到達してるので動かなくなるのです。
最初からMax値を非常に大きくするという手はありますが、その設定だとバーを持って動かせばMax値まで持っていく事が出来てしまい、今日の日付に戻すのが大変になってしまいます。ですので、スクロールバーは１回の操作で最大７日とし、同じ操作を繰り返せば同じだけ移動するようにバーの位置を中立（ Value = 0 ）にしているのです

バーを中立にする理由は理解していただけたとして、７７行目のValue = 0 のコードを実行すると「ユーザに値を変更された」と、スクロールバー側は判断してしまい、対応するマクロ「ScrollBar1_Change」を動かし始めるのです。この時点では既に画面は新しい日付のスケジュールに替わっています。Value値がゼロですから同じ日付のデータを往復させているだけになるので表面上は変化ありませんが、無駄な動作のため防止すべきです。ですので変数Bar0のフラグがTrueになっていたらプロシージャを抜けるようにしました。

７１行目は、現在の日付（変数 Date_.Value ）にスクロールバーで変更した値（Value値）を足した値を、新たな日付としてRange変数 Date_ に代入しています。

日付が新しくなった後で７３行目で左欄（SC1）の値をクリアし、７４行目で新たな日付のデータを検索・貼付けさせています。

７６～７８行目は、先ほど説明した理由で変数Bar0をTrueにした後、スクロールバーのValue値をゼロにしています。バーを中立にしたら変数Bar0を規定値のFalseに戻します。

３－６.サブプログラム

以下は、ボタンやスクロールバーに登録されているマクロの中から呼び出されるプロシージャです。７つのSubプロシージャ、Functionプロシージャを今回使用しています。

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

まず、この「Search_Data」関数は、引数として日付＋時刻のデータを「Double」型で受け取ります。
８２～８３行目は、プロシージャ内で使用する変数の宣言です。８２行目のSearch_Range変数は、保存シート内に存在するデータの内、日時データの範囲（＝検索範囲）を示します。また、８３行目のNo変数は「検索範囲の中で目的の値が見つかった相対位置」を代入します

８５行目は検索範囲を計算し、変数Search_Rangeに代入します。その計算方法について図３－１１で説明します。

図３－１１

まず Last_Row というのが出てきますが、これは図３－１６の自作関数です。機能は保存シートのデータの最終行を返してきます。（図３－１１の左図）
その値を使用して「Resize(Last_Row - 1, 1)」のサイズを計算します（図３－１１の中央図）。Resizeの元となるセル範囲はSave_ですので「Save_.Resize(Last_Row - 1, 1)」は図３－１１の中央図の赤い実線範囲になります。
その実線範囲を「.Offset(1, 0)」することで、１セル分下に下がりますので、最終的には「実データが存在するデータ範囲 ＝ 検索範囲（図３－１１の右図）」を求めることができます。

次に８８行目でMatchを使って検索をします。第一引数の「検索する値」は DateTimeという日付＋時刻のDouble値で、このSearch_Data関数に渡された引数です。また、第二引数の「検索範囲」は８５行目で求めたSearch_Range、第三引数のゼロは「完全一致」という意味です。
このMatchは、検索値が検索範囲の中に見つかればその相対位置を、見つからなければ「#N/a（エラー値）」が返されます。この場合、受ける変数NoはDouble型ですのでエラー値を受けられずエラー（エラー番号1004）となります。よってプログラムが中断しない様に直前の８７行目でエラー回避（エラーが発生してもスルーする）を入れています。

正常に検索値が見つかった場合にはエラーが発生しないので８９行目のIf Err = 0 が成立し、９０行目を実行します。
９０行目の式である「Save_.Offset(No, 0)」について図３－１２で説明します。例えば３番目のデータが合致したとするとNo = 3 が得られます。基準のSave_はＢ１セルを指していますので、Offset（3,0）はそこから下方向に３つ下がったセル　と言うことになります。（図３－１２の右側図）

図３－１２

９０行目では、このセルの位置（Range型）を関数Search_Dataの返り値として返します。
なお、検索値が見つからなかった場合は、９２行目で返り値をNothingにしています。

なお今回のマクロでは、この Search_Data 関数を使用している一つ上のプロシージャ（ Data_Paste、Data_Delete ）の中でもエラー回避をしている（二重にエラー回避している）ため、Search_Data 関数内のエラー回避は無くても一応正常には動くようです。
但し、今後システムを改造・拡張された時の事を考慮し、エラーが起こり得る場所ではキチンとエラー処理をしておくのが良いと思っています。

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

９８～９９行目は、プロシージャ内で使用する変数の宣言です。
９８行目は時刻を入れる変数Tですが、ここではDate型の 1.0／24時間 ではなく、例えば「9:30」だったら「9.5」というような形にしています。これは１０１行目の For ～ Next文で３０分単位でStepさせて計算させるためです。
通常は For ～ Next文は通常のStep 1 で回し、その後で時刻に変換する式を作るかと思いますが、１０１行目の様な式も直感的で理解し易いのでは、と思います。
９９行目の変数Rですが、こちらが行数を数えていることになります。

１０１行目は、開始時刻（Time_S）から終了時刻（Time_E）まで３０分単位（0.5）で For～Next を回し、それとセットで変数 R を１０２行目で順に増やしています。

１０４行目では、日時に合致したデータがあったら、その横（Offset(0,1））に保存されている「Work（業務内容）」を左欄に１行ずつ貼り付けているコードです。
「DateTime(D, T)」では、このプロシージャの引数である日付（D）とFor～Nextの変数TをDateTime関数に引数として渡し、返り値としてDouble型の日時データを受け取ります。それを「Search_Data())」に引数として渡し、保存データの中にデータがあったらセル範囲（Range型）を返してきますので、そのセル範囲を基準に「.Offset(0, 1)」で一つ右側に移動させ「.Value」でそのセルの値（文字列など）を受け取ります。
受け取った値を ＝の左辺である「SC1(R)」に貼り付けます。行と同じ役割をする変数 R は順に増えていきますので、範囲SC1の上から順にセルを追っていく事になります。SC1はRange型ですので「SC1(R) = 〇〇」で値貼付けが出来てしまいますが、正式にコードすれば「SC1(R).value = 〇〇」の方がBetterかもしれません。
尚、１０４行目は、データが見つからなかった時にはエラーが発生しますので、直前の１０３行目にエラー回避をしています。
今回は１行１行データを貼り付けましたが、データが多くなると処理時間が増えますので、配列を使って格納し一気に貼り付ける方法が効果あります。

図３－１４の「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
図３－１４

１１１行目で、引数の日時データを「Search_Data」関数に渡し、検索されたデータ（Range型のセル範囲）を「.EntireRow.Delete」で行ごと削除します。該当するデータが存在しないとエラーが発生（＝行が削除できない）しますので、直前の１１０行目でエラー回避をしています。
実は、この行削除が今回システムの最重要プロシージャです。引数の日時データが与えられると言うことは、上書き（又は追加・削除）するデータがあると言うことです。このプロシージャで日時データの削除に失敗すると「同じ日時のデータが複数存在する」ことになり、データの完全性が崩れます。データが複数存在すると、Search_Dataで検索しても最初に合致したセルしか返ってこないはずですので「いくらデータ更新しても新しいデータが表示されない」みたいな現象が起こります。
完全性を確保するためには、削除した後にもう一度検索をしてみて「何も存在しない事」を確認するくらい念入りでも良いと思います。

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

この Data_Clear は、引数として渡されるのは「範囲 SC1」または「範囲 SC2」のどちらかになります。また、セルデータをクリアするには以下のような方法があります。
１）　セル範囲 ＝ ""　　　(←１１６行目の方法)
２）　セル範囲.ClearContents 　　（←文字と数式を削除）
３）　セル範囲.Clear　　（←書式まで削除される方法）
４）　For Each 〇 In セル範囲　／　〇.ClearContents　　　　（←部分的に削除）

他にも書式だけ削除する「ClearFormats」なども存在しますので必要に応じて使って下さい。

図３－１６の「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
図３－１６

最終行検索には様々な方法があり、世の中のサイトでも色々紹介されています。
１）Endプロパティで、一番下から空ではないセルに停止させる方法（今回の方法）
２）Endプロパティで、一番上から空セルの一つ手前で停止させる方法
３）CurrentRegionプロパティで空行・空列で囲まれた範囲を取得する方法
４）UsedRangeプロパティで使われた形跡のある範囲を取得する方法
５）上から１行１行空欄か確かめる方法

今回１２０行目で使用した「Save_.Parent.Cells(Rows.Count, Save_.Column).End(xlUp).Row」を説明します。他の方法は別の機会に説明していきたいと思います。

先頭の「Save_.Parent」については、図３－４の４４行目についての説明でも書きましたが再度説明します。 モジュール変数 Save_ には、図３－３の２２行目で「Sheets("sheet2").Range("b1")」というセル範囲が代入されていますので、その親（Parent）はワークシートである「Sheets("sheet2")」という事になります。
そのSheet2の中のセルは「.Cells(行,列)」で表されます。今回の式では「行」の部分には「Rows.Count」、「列」の部分には「Save_.Column」が入っています。

まず行側の「Rows.Count」は正式に記述すると「Application.Rows.Count」であり、「Excel」の「すべての行」の「数」　という意味になります。ですのでExcel2007以降ならば「1,048,576（2の20乗）」です。
ちなみに、この「Application」を「Range("A20:B40")」に変えると、「すべての行（Rows）」の対象が A20:B40 になりますので「２１」という縦の行数が返ります。また「Rows」の代わりに「Columns」を使うと「16,384」というワークシートの「すべての列」の数が求まります。

列側の「Save_.Column」の前半のモジュール変数Save_ には、「Sheets("sheet2").Range("b1")」が代入されています。後半の「Column」は先ほどの「Columns」と似ていますが「s」が付いていません。「s」がないと「すべての列」では無く「その列番号」という意味になります。英語の単数形と複数形みたいな感じです。ですので「Save_.Column」は「B1セルの列番号」という意味になり「２」という値が返ってきます。
ということで、「Save_.Parent.Cells(Rows.Count, Save_.Column)」は「Sheet2の一番下の行のB列のセル」を表しています。

その次の「.End(xlUp)」ですが、これは「キーボードのEndキーを押しながら、上方向キー↑（xlUp）を押す」の意味です。実際にやってみると、何かが記入されているセルのところまで飛んでいきます。下から上に向かって飛びますので一番下にあるデータのセルまで飛んでいくことになります。

最後に「.Row」があります。単数形ですので「その行」という意味です。ですので、「Save_.Parent.Cells(Rows.Count, Save_.Column).End(xlUp).Row」は「一番下のデータの行番号」となります。スケジュール帳を使う前でしたら、タイトル部になりますので「１」が返ってきます。これが Last_Row 関数の返り値になります

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

人間の目で見れば「７行目は 10:00 だよね」とすぐ分かるのですが、機械には教えてあげなくてはいけません。
変換式は１２４行目の「(R + (Time_S * 2 - SC1.Row)) / 2」です。まずはカッコの一番奥側の「Time_S * 2 - SC1.Row」ですが、「Time_S」はスケジュール帳の開始時刻（＝ 8（8:00という意味））の数字です。またモジュール変数SC1は図３－３の１９行目で「Sheets("sheet1").Range("c3:c30")」が代入されていますので「SC1.Row」は「SC1の行」だから・・・　と、ここで「「３～３０」のどれが返ってくるのだろう？？」と思う方もいると思います。
もう少し丁寧に記述すれば「SC1(1).Row」と言うことで、「範囲SC1の左上から数えて1番目のセル」の「その行番号」となりますので、単純に言えば「範囲SC1の上端の行位置」となり「３」となります。
（更に「SC1(1).Row」をもっと正確にいうと「「SC1.Item(1).Row」」であり、Itemは図３－１８の様に数えていきます。）

ですので「(R + (Time_S * 2 - SC1.Row)) / 2」は、「(行位置 + (8 * 2 - 3)) / 2」となります。最初の「７行目は 10:00 だよね」で試してみましょう。行位置に「７」を入れると、「(7 + (8 * 2 - 3))/2 = 10」 となり、合っているのが確認できます。

図３－１８

図３－１９の「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
図３－１９

第一引数は通常のDate型の日付、第二引数は今回のスケジュール帳で使用している３０分単位の数字（例：9:30 → 9.5）なのでSingle型にしています。
１２８行目は「D + T / 24」という計算式で、１日は２４時間ですので１日を０～１に割り振っていることになります。この値は、時刻を含んだDate型と同じ値（両方とも８バイトで同じです）ですが、この関数の返り値はワザとDouble型で返しています。
この理由は図３－１のところでも書きましたが、保存データと検索値がDate型だと上手く検索できず、Double型にしてみると正しく動いたことによります。まだキッチリ説明できませんが、また調べてみたいと思います。

４．最後に

スケジュール帳という名を借りた「小さなデータベース」です。データベースというとSelect、Insert、Update、Delete の操作がありますが、今回は Update が無い形です。ユニークデータ（今回で言えば、同じ日時のデータは無い）であれば、このようなやり方もありかもしれません。



テキストデータのスケジュール帳１（it-018.xlsm）

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