まりふのひと

家庭血圧グラフ.xlsmにWorksheetオブジェクトを作り入力方法の一部を変更した

いきさつ

 4月29日(土曜日)の午前中こと‥‥
高血圧の薬が切れるので、午前中に吉村胃腸科内科医院に行ったら、駐車している車が1台も無い。
玄関も締まっており、「GW中の休診日のお知らせ」の張り紙も無い。
土曜日は午前中のみの診療のはずだが...
 帰宅し、ネットを "吉村胃腸科内科医院 ゴールデンウイーク" で検索したら‥‥

『5/3から5/5までゴールデンウィーク期間の休業日』とあった。
とりあえずその旨だけを Googleカレンダーに入力しておこう‥‥ と、PCで開いて気が付いた。

祝日は赤地で表示するようにしてある
今日は  昭和の日 、祝日じゃあ~~~
 膝痛と腰痛で通っている「さいとう整形外科」の、先生には「リハビリを続けるように」と、理学療法士さんには「週に2~3回来なさい。サボっちゃーいけませんょ」と言われているが
ブログをもっと更新しないと(脳が)退化しますょ
と忠告されているような気がして...


Excel家庭血圧グラフの改修

 下図は、月一、高血圧の薬を貰いに行く時に持って行っている家庭血圧グラフで、

  • グラフデータは測定2回の平均値で作図している。
  • 右端の4月中旬のように、データが無い時は「データ要素を線で結ぶ」にしているが、データは計算式で作っているので、これが面倒だった。

改修のポイント

 血圧データは原則毎日測定しているので、1ヶ月分の日付は事前にフィルハンドルでコピーして作ってある。
例えば下図は6月一ヶ月分のデータを作ったもので、

未入力の日は、計算式(平均値)のセルは「#DIV/0!」(0 で割った)が表示される。
 4月は血圧計の操作ミスで 4/10夜~4/19朝のデータを消してシマッタ!
このままグラフを作ると「#DIV/0!」は「ゼロ」と見なされ、面白くないので、「#DIV/0!」のセルをクリアするマクロは作って計算式を消していた。
そこで、今回のトラブルを機に、

  • 測定した日のデータのみ入力する。
     但し、朝または夜の測定値が無い場合は、これまでどおりグラフ作成時に「#DIV/0!」セルをクリアする。(まだ改善の余地がある‥‥ ということ)
  • 具体的には、
     時刻(B列)にカーソルが来た時、測定日(A列)に入力があれば、直上の U列~AC列の計算式をコピーする

マクロ(VBA)の改修

Sub名:次の空白朝時刻にカーソルを移す
  • ショートカット:Ctrl+Shift+N(N は New の積り)
  • 改修点:測定日が未入力の時は、測定日にカーソルを移す。
Sub名:Worksheet_SelectionChange(Worksheetオブジェクト)
  • 新規作成‥‥ Worksheetオブジェクトに記述する
  • 機能
    1. B列がアクティブ(Target.Column)になった時
    2. 測定日に入力があり、朝時刻が未入力の場合、警告を出して、直上の数式をコピーする。
  • VBAコード
     機能確認優先のため汎用性はない。
01.Private Sub Worksheet_SelectionChange(ByVal Target As Range)
02.Dim mbTitle As String
03.Const B列 As Long = 2
04.Const U列 As Long = 21
05.Const AC列 As Long = 29
06.Dim i As Long, c As Long, r As Long
07.
08.  mbTitle = "Worksheet_SelectionChange/" & ThisWorkbook.Name
09.    'B列がアクティブになったら、直上の行の数式をコピーする。
10.  If Target.Column = B列 Then
11.    r = ActiveCell.Row
12.    c = ActiveCell.Column
13.    If ActiveCell <> "" Then Exit Sub
14.    If Cells(r, c - 1) = "" Then Exit Sub
15.    If MsgBox("直上の U~AC列の値(数式等)をコピーしますか?", vbYesNo + vbQuestion, mbTitle) _
16.      = vbNo Then Exit Sub
17.      'Ctrl+D(同上)を行う。
18.    For i = U列 To AC列
19.      Cells(r, i).FillDown
20.    Next
21.  End If
22.    
23.End Sub

改修結果

 今のところ不具合は発生していないが...