まりふのひと

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

Excel VBA

いきさつ

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

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

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

Excel家庭血圧グラフの改修

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

  • グラフデータは測定２回の平均値で作図している。
  • 右端の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

改修結果

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