“スマホで簡単！血圧測定から医療機関提出まで、エクセルVBAでスマートな健康管理を実現する方法”

健康
36
2view

健康

CSVファイルをメモ帳で開きます。

名前を付けて保存します。エンコードは文字化けを防ぐためANSIを選んで下さい。

エクセル上でのワークシート、ＶＢＡの作成

エクセルを開いて次のシートを作成します。

“血圧記録表”:血圧記録をまとめた血圧記録表です。医療機関に提出したり、保存します。

“imdata”:メールで受け取った生のデータです。

“グラフ”：血圧、脈拍データのグラフです。

“使用方法”:血圧記録表作成手順を説明したものです。

シート”血圧記録表”追加、測定日の記入:10月1日から11月30日としました。

シート”imdata”追加してそこにメモ帳で保存したデータを貼り付けます。

CSVファイルをエクセルで開きます。

最大1000日分のデータがあります。

データは2022年1月8日からとなっていますが1年毎にデータをまとめた方が分かりやすいのでこの中から今年のデータ2023年1月1日から最終日のデータをコピーし、シート”imdataに貼り付けます。

2023年1月1日から最新のデータを2023血圧記録作成シート”imdata”に貼り付けます。

マクロの作成

マクロの概要：血圧記録表の測定日2023年10月1日のデータをシート”imdata”から検索します。

データがあれば測定時間、朝、夜に測定した血圧、脈拍を記録表に貼り付けていきます。

Sub 血圧記録()

‘2023血圧記録作成を開く

oopnfn = Workbooks(1).Name

For Each sh In Workbooks(oopnfn).Windows(1).SelectedSheets

‘シート血圧記録表を選択

　shname = sh.Name

Next

　Sheets(shname).Activate

‘マクロの速度を向上させるため、画面を更新しないようにします。

　Application.ScreenUpdating = False

‘8行から374行まで処理(1年366日まで)

 　For d = 8 To 374

‘データ処理進行状態を表示

 　n = 366
 　po = 0
 　po = Int((d - 8) * 10 / n)

 　Application.StatusBar = "只今データ処理中です　" & d - 8 & "/ " & n & "  " & String(po, "■") & String(10 - po, "□")

‘シート”血圧記録表”を選択

 Sheets(shname).Activate

‘測定日の読み込み

 gdate = Cells(d, 1)

‘シート”imdata”を選択

 Sheets("imdata").Activate

‘検索する範囲を指定(1000日まで)

  Range("A1:i2001").Select

‘測定日”gdate”を検索します。

  Set c = Application.Selection.Find(What:=gdate, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
    False)

 If Not c Is Nothing Then

   c.Activate

‘朝の測定時間

 ttime1 = Cells(c.Row, 2)

‘夜の測定時間

 ttime2 = Cells(c.Row + 1, 2)

‘備考

 memo = Cells(c.Row, 9)

‘朝、夜測定データあり

 If Cells(c.Row, 1) = Cells(c.Row + 1, 1) Then

‘朝の最高血圧

  asamax = Cells(c.Row, 3)

‘朝の最低血圧

  asamin = Cells(c.Row, 4)

‘朝の脈拍

  asabit = Cells(c.Row, 5)

‘夜の最高血圧

  yorumax = Cells(c.Row + 1, 3)

‘夜の最低血圧

  yorumin = Cells(c.Row + 1, 4)

‘夜の脈拍

  yorubit = Cells(c.Row + 1, 5)

 Sheets(shname).Activate

‘血圧記録表に朝、夜の測定した時間、最高、最低血圧、脈拍を記入

 Cells(d, 2) = ttime1
 Cells(d, 6) = ttime2
 Cells(d, 3) = asamax
 Cells(d, 7) = yorumax
 Cells(d, 4) = asamin
 Cells(d, 8) = yorumin
 Cells(d, 5) = asabit
 Cells(d, 9) = yorubit
 Cells(d, 10) = memo

 End If

 Sheets("imdata").Activate

‘朝のデータがあり、夜のデータがない場合

If Cells(c.Row, 1) <> Cells(c.Row + 1, 1) And ttime1 < 0.5 And ttime1 > 0.1 Then

 asamax = Cells(c.Row, 3)
 asamin = Cells(c.Row, 4)
 asabit = Cells(c.Row, 5)

Sheets(shname).Activate

 Cells(d, 2) = ttime1
 Cells(d, 6) = ""
 Cells(d, 3) = asamax
 Cells(d, 7) = ""
 Cells(d, 4) = asamin
 Cells(d, 8) = ""
 Cells(d, 5) = asabit
 Cells(d, 9) = ""
 Cells(d, 10) = memo

End If

Sheets(“imdata”).Activate

‘夜のデータがあり、朝のデータがない場合

If Cells(c.Row, 1) <> Cells(c.Row + 1, 1) And ttime1 > 0.6 And ttime1 < 1 Then

 yorumax = Cells(c.Row, 3)
 yorumin = Cells(c.Row, 4)
 yorubit = Cells(c.Row, 5)

Sheets(shname).Activate

 Cells(d, 2) = ""
 Cells(d, 6) = ttime1
 Cells(d, 3) = ""
 Cells(d, 7) = yorumax
 Cells(d, 3) = ""
 Cells(d, 8) = yorumin
 Cells(d, 4) = ""
 Cells(d, 9) = yorubit
 Cells(d, 10) = memo

 End If

Sheets(“imdata”).Activate

Cells(1, 1).Select

Sheets(shname).Activate

Else:

 Cells(d, 3) = ""
 Cells(d, 7) = ""
 Cells(d, 4) = ""
 Cells(d, 8) = ""
 Cells(d, 5) = ""
 Cells(d, 9) = ""

 End If

Next d

Sheets(“imdata”).Activate

Cells(1, 1).Select

Sheets(shname).Activate

Application.StatusBar = False

Application.ScreenUpdating = True

End Sub

1. 開発タブにある挿入から、ボタンのアイコンをクリック

2. ボタンを設置したい箇所でボタンサイズをドラッグするとマクロの登録画面となるので実行するマクロ名を選択します。

マクロボタンに”データ読込”と名前を付けます。
“データ読込”ボタンをクリックします。

2023年10月1日から2023年11月30日までのデータが読み込まれました。

グラフの作成

測定日、朝の最高血圧、最低血圧、脈拍、夜の朝の最高血圧、最低血圧、脈拍を10月31日までドラッグします。データ系列が多いとグラフが正しく表示されないことがあります。

作成するグラフを選びます。

グラフが作成されました。

グラフエリアを右クリックするとグラフ移動の画面が出てきます。

グラフをシート”グラフ”に移動します。

グラフエリアを右クリックするとグラフの配置先画面が出てきます。

シート”グラフ”を選択します。

グラフをシート”グラフ”に移動しました。

グラフを設定していきます。
グラフ表示範囲
　グラフの系列をクリックします。どの系列でもかまいません。
　矢印の部分はグラフ範囲の最大38行となっています。
　最大1年(366日)のデータをグラフ化しますのでデータの範囲は8行から374行(366+8)となります。
　矢印の部分を38から374に変更して下さい。全ての系列を変更して下さい。

グラフ系列名

グラフ系列1を選択して右クリックします。データの選択を選んで下さい。

グラフ軸の書式設定

グラフが移動したらグラフの系列をクリックします。

矢印の部分はグラフ範囲の最大行番号となっています。

1年(366日)の行番号は374ですので374に変更します。

同様に全ての系列を変更して下さい。

以上です。

健康管理のため長年血圧測定を続けてきました。

血圧測定してスマホアプリにデータを入れるだけで記録シート、グラフが作成されます。

このアプリで血圧記録は完結されますが医療機関へ提出するものとしてはふさわしくありません。

このため血圧データをＰＣに取り込んでエクセルＶＢＡで作成しました。

2021年12月に投稿した「健康で毎日楽しく過ごすために続けている事」の血圧測定に関して詳細に説明したものです。

血圧測定

毎日決めた時間で血圧策定します。朝は朝食前、夜は就寝前としました。
血圧測定は３回してその平均をとりました。
そのデータをスマホアプリに入れます。このアプリはシンプルでわかりやすいです。
データは最大1000日分保存されます。

アプリの紹介

CSVファイルをメモ帳で開きます。

名前を付けて保存します。エンコードは文字化けを防ぐためANSIを選んで下さい。

エクセル上でのワークシート、ＶＢＡの作成

“グラフ”：血圧、脈拍データのグラフです。

“使用方法”:血圧記録表作成手順を説明したものです。

シート”血圧記録表”追加、測定日の記入:10月1日から11月30日としました。

シート”imdata”追加してそこにメモ帳で保存したデータを貼り付けます。

CSVファイルをエクセルで開きます。

2023年1月1日から最新のデータを2023血圧記録作成シート”imdata”に貼り付けます。

マクロの作成

Sub 血圧記録()

‘2023血圧記録作成を開く

oopnfn = Workbooks(1).Name

For Each sh In Workbooks(oopnfn).Windows(1).SelectedSheets

‘シート血圧記録表を選択

　shname = sh.Name

Next

　Sheets(shname).Activate

‘マクロの速度を向上させるため、画面を更新しないようにします。

　Application.ScreenUpdating = False

‘8行から374行まで処理(1年366日まで)

 　For d = 8 To 374

‘データ処理進行状態を表示

 　n = 366
 　po = 0
 　po = Int((d - 8) * 10 / n)

 　Application.StatusBar = "只今データ処理中です　" & d - 8 & "/ " & n & "  " & String(po, "■") & String(10 - po, "□")

‘シート”血圧記録表”を選択

 Sheets(shname).Activate

‘測定日の読み込み

 gdate = Cells(d, 1)

‘シート”imdata”を選択

 Sheets("imdata").Activate

‘検索する範囲を指定(1000日まで)

  Range("A1:i2001").Select

‘測定日”gdate”を検索します。

  Set c = Application.Selection.Find(What:=gdate, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
    False)

 If Not c Is Nothing Then

   c.Activate

‘朝の測定時間

 ttime1 = Cells(c.Row, 2)

‘夜の測定時間

 ttime2 = Cells(c.Row + 1, 2)

‘備考

 memo = Cells(c.Row, 9)

‘朝、夜測定データあり

 If Cells(c.Row, 1) = Cells(c.Row + 1, 1) Then

‘朝の最高血圧

  asamax = Cells(c.Row, 3)

‘朝の最低血圧

  asamin = Cells(c.Row, 4)

‘朝の脈拍

  asabit = Cells(c.Row, 5)

‘夜の最高血圧

  yorumax = Cells(c.Row + 1, 3)

‘夜の最低血圧

  yorumin = Cells(c.Row + 1, 4)

‘夜の脈拍

  yorubit = Cells(c.Row + 1, 5)

 Sheets(shname).Activate

‘血圧記録表に朝、夜の測定した時間、最高、最低血圧、脈拍を記入

 Cells(d, 2) = ttime1
 Cells(d, 6) = ttime2
 Cells(d, 3) = asamax
 Cells(d, 7) = yorumax
 Cells(d, 4) = asamin
 Cells(d, 8) = yorumin
 Cells(d, 5) = asabit
 Cells(d, 9) = yorubit
 Cells(d, 10) = memo

 End If

 Sheets("imdata").Activate

‘朝のデータがあり、夜のデータがない場合

If Cells(c.Row, 1) <> Cells(c.Row + 1, 1) And ttime1 < 0.5 And ttime1 > 0.1 Then

 asamax = Cells(c.Row, 3)
 asamin = Cells(c.Row, 4)
 asabit = Cells(c.Row, 5)

Sheets(shname).Activate

 Cells(d, 2) = ttime1
 Cells(d, 6) = ""
 Cells(d, 3) = asamax
 Cells(d, 7) = ""
 Cells(d, 4) = asamin
 Cells(d, 8) = ""
 Cells(d, 5) = asabit
 Cells(d, 9) = ""
 Cells(d, 10) = memo

End If

Sheets(“imdata”).Activate

‘夜のデータがあり、朝のデータがない場合

If Cells(c.Row, 1) <> Cells(c.Row + 1, 1) And ttime1 > 0.6 And ttime1 < 1 Then

 yorumax = Cells(c.Row, 3)
 yorumin = Cells(c.Row, 4)
 yorubit = Cells(c.Row, 5)

Sheets(shname).Activate

 Cells(d, 2) = ""
 Cells(d, 6) = ttime1
 Cells(d, 3) = ""
 Cells(d, 7) = yorumax
 Cells(d, 3) = ""
 Cells(d, 8) = yorumin
 Cells(d, 4) = ""
 Cells(d, 9) = yorubit
 Cells(d, 10) = memo

 End If

Sheets(“imdata”).Activate

Cells(1, 1).Select

Sheets(shname).Activate

Else:

 Cells(d, 3) = ""
 Cells(d, 7) = ""
 Cells(d, 4) = ""
 Cells(d, 8) = ""
 Cells(d, 5) = ""
 Cells(d, 9) = ""

 End If

Next d

Sheets(“imdata”).Activate

Cells(1, 1).Select

Sheets(shname).Activate

Application.StatusBar = False

Application.ScreenUpdating = True

End Sub

1. 開発タブにある挿入から、ボタンのアイコンをクリック

2. ボタンを設置したい箇所でボタンサイズをドラッグするとマクロの登録画面となるので実行するマクロ名を選択します。

マクロボタンに”データ読込”と名前を付けます。
“データ読込”ボタンをクリックします。

2023年10月1日から2023年11月30日までのデータが読み込まれました。

グラフの作成

作成するグラフを選びます。

グラフが作成されました。

グラフエリアを右クリックするとグラフ移動の画面が出てきます。

グラフをシート”グラフ”に移動します。

グラフエリアを右クリックするとグラフの配置先画面が出てきます。

シート”グラフ”を選択します。

グラフをシート”グラフ”に移動しました。

グラフ系列名

グラフ系列1を選択して右クリックします。データの選択を選んで下さい。

グラフ軸の書式設定

以上です。

最新情報をチェック！

フォローする