2020/02/26

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




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

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

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

図1-1

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

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

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

図2-1

記入側(Sheet1)の2行目には2つのボタンを配置しています。右の「保存」ボタンには「Data_Save」マクロを、左の「削除」ボタンには「Data_Select_Delete」マクロを登録しています。
その上のスクロールバーの設定は、図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

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

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

7~10行目は Range 型の変数宣言で、実質は定数です。スケジュールを表示する画面( SC1 )、スケジュールを入力・修正する画面( SC2 )、保存先( Save_ )、表示日付セル( Date_ )の4範囲を図3-2の19~22行目で代入しています。
11行目の変数 Bar0 については、図3-9で詳細説明します。

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

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

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

宣言部(図3-1)の7~10行目で宣言したRange型変数(定数相当)に値を代入するのが図3-3の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-3

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

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

3-3.「保存」ボタン押下時の動作

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

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

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

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

36行目では、「日付+時刻の数値をDouble型」で配列SC_Dataの1つ目に代入しています。
日付+時刻の値は、別関数 DateTime の引数として「日付」と「時刻」を別々に渡すと取得できます(図3-19)。日付はRange変数 Date_ の値を使えば良いのですが、この段階では時刻は不明です。ですので時刻を求めるために、Row2Time 関数に引数として R の行位置(R.row)を渡して時刻を取得しています(図3-17)。
37行目は、セルRに入っている文字列ですので、R.Value を配列SC_Dataの2つ目に代入するだけでOKです

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

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

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

transpose関数での配列の列・行の入れ替わり
図3-5

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

図3-6

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

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

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

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

3-4.「削除」ボタン押下時の動作

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

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

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

図3-8

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

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

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

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

最も上にある「スクロールバー」を操作(値を変更)した時の登録マクロは、以下(図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.  Call Data_Clear(SC1)        '←左欄の値をクリア
  7.  Call Data_Paste(Date_.Value)   '←新たな日付でデータを探して、左欄に貼る
  8.  Bar0 = True            '←フラグを立てて、再画面更新をしない様にする
  9.   ScrollBar1.Value = 0      '←スクロールバー値を変更(ゼロに戻し、中立位置にする)
  10.  Bar0 = False
  11. End Sub
図3-9

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

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

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

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

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

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

3-6.サブプログラム

以下は、ボタンやスクロールバーに登録されているマクロの中から呼び出されるプロシージャです。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

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

85行目は検索範囲を計算し、変数Search_Rangeに代入します。その計算方法について図3-11で説明します。

図3-11

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

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

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

図3-12

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

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

図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

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

101行目は、開始時刻(Time_S)から終了時刻(Time_E)まで30分単位(0.5)で For~Next を回し、それとセットで変数 R を102行目で順に増やしています。

104行目では、日時に合致したデータがあったら、その横(Offset(0,1))に保存されている「Work(業務内容)」を左欄に1行ずつ貼り付けているコードです。
「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かもしれません。
尚、104行目は、データが見つからなかった時にはエラーが発生しますので、直前の103行目にエラー回避をしています。
今回は1行1行データを貼り付けましたが、データが多くなると処理時間が増えますので、配列を使って格納し一気に貼り付ける方法が効果あります。

図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

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

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

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

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

図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

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

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

先頭の「Save_.Parent」については、図3-4の44行目についての説明でも書きましたが再度説明します。 モジュール変数 Save_ には、図3-3の22行目で「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 になりますので「21」という縦の行数が返ります。また「Rows」の代わりに「Columns」を使うと「16,384」というワークシートの「すべての列」の数が求まります。

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

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

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

図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

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

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

図3-18

図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

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

4.最後に

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



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

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