エクセル 毎日測定するデータを対象ごとに別シートで自動表記したいのですが・・・。

30床の高齢者施設で毎朝バイタル（体温・最高血圧・最低血圧・血中酸素濃度）を測定しています。
朝の測定時は1枚の紙に全員のバイタル値を記入(①）しますが、
日中に個人別にひと月分入力できるシートに手打ちで転記(②）しています。
これをひとつのエクセルブックで①を入力したら
30枚の個人別シートにその日のデータが表記されるようにしたいと考えております。

①のシートは15名ずつ2列に分けて
Ａ1～Ａ15　個人名、Ｂ1～Ｂ15　最高血圧、Ｃ1～Ｃ15　最低血圧、Ｄ1～Ｄ15　体温、
Ｅ1～Ｅ15　血中酸素濃度、
Ｇ1～Ｇ15　個人名、Ｈ1～Ｈ15　最高血圧、Ｉ1～Ｉ15　最低血圧、Ｊ1～Ｊ15　体温、
Ｋ1～Ｋ15　血中酸素濃度　を記入しています。
Ｌ1には測定した日にちの数字のみを入れています。

②の個人別の30名分のシートは
Ａ1　名前を記入
項目としてＡ2　日付　Ｂ2　最高血圧、　Ｃ2　最低血圧、Ｄ2　体温、Ｅ2　血中酸素濃度、
Ａ3～Ａ34までが日付の数字（１～31）のみです。　

日付によって①のデータを個人別の他シートで日別に表記する、
過去の日付のデータも消さないでおくのはどのような数式を入れたら良いか
教えて頂けませんでしょうか？

宜しくお願い致します。

No.1 ベストアンサー 回答者： soixante 回答日時： 2015/10/10 21:52

それは大変ですね。

これはマクロを使用したほうが良いでしょう。
ラクしましょう。

以下の前提で設計しました。
・全員分を入力するシート①は、一枚目（一番左）のシート
・各個人データのシートは、2枚目から31枚目
・セルの配置は質問文通り

●準備

１．該当エクセルの上で、Alt+F11
２．別の画面（Visual Basic for Applications)が開くので、そこで、
　　Alt + I、M
３．真っ白な画面が開きますので、以下のコードを貼り付ける。点線から点線部分。

’-------------------------------------------------------------
Sub データ転記()

'変数宣言
Dim k As Integer, r As Integer, c As Integer
Dim Nam As String, Rng As Range
Dim Ws1 As Worksheet, Hiduke As Integer
Set Ws1 = Worksheets(1)

'日付を決める
Hiduke = InputBox("日付を入力")

'データを各個人シートに転記
Application.ScreenUpdating = False
For c = 1 To 6 Step 5
For r = 1 To 15
Ws1.Select
Nam = Cells(r, c).Value　’個人名を取得

'2枚目以降のシートのA1セルを見て、該当個人シートを探しに行く
k = 2
Do Until Worksheets(k).Cells(1, 1).Value = Nam
k = k + 1
Loop

'転記するデータをコピーし、該当シートの該当日付の行に貼り付ける
With Ws1
Set Rng = .Range(.Cells(r, c + 1), .Cells(r, c + 4))
End With

Rng.Copy
Worksheets(k).Cells(Hiduke + 2, 2).PasteSpecial Paste:=xlPasteAll
Next r
Next c
Application.CutCopyMode = False
Application.ScreenUpdating = True

MsgBox Hiduke & "日の転記完了"
End Sub
’-------------------------------------------------------------

★元には戻せませんので必ずバックアップを取ったうえでお試しください★
●実際の使用時　
１．全員分のシートを入力する
２．Alt + F8
３．データ転記を選んで実行

●もっと楽にするには
①シートの上にボタンを設置しましょう。

１．エクセルの上のほうにあるリボンの中から「開発」タブを選択
　開発タブが無い場合は以下の手順で。
　　i. 上のほうにあるリボンの一番左「ファイル」＞「オプション」＞「リボンのユーザー設定」
　　ii. 右半分に出てくるメインタブの中の、「開発」に　レ点を入れてOK

２．開発タブの中の「挿入」（トンカチとスパナと道具箱の絵が描いたボタン）を押す
３．一番左上の、「ボタン」を押す
４．①シートの、適切な所まで移動する。そこでポインタが　+　になるはず。
５．配置したいところに行ったら、マウスの左を押しながら、適当な大きさとする
６．マウスの左を離すと、「マクロの登録」が開くので、「データ転記」を登録すれば終わり。

これで①シートから各個人シートへの転記はあっという間に終わるはずです。
私の手元のダミーでは正常作動しました。

なお、
①シートの個人名と、2枚目以降のA1セルにある個人名は同一でなければエラーとなります。
（姓名の間のスペースの有無とかも影響しますので注意）

●その他～メンテナンス
・月替わりの時の処理・・・どういう処理でしょう。全部クリア？　30枚、手作業でやってもいいですけど面倒ではあります。
　　　　　　　　　　　　　これもマクロを入れといてもいいかもしれません。なにかあればどうぞ。
・入所者が30名以上になることは無いか・・・これはコードをいじる必要あり。
・入所者が変わる時の対応・・・これは①と個人シートのA１セル変更で対応可

この回答へのお礼

ありがとうございました。
なんとか頑張ってみます！

お礼日時：2015/10/11 15:48

No.2 回答者： soixante 回答日時： 2015/10/10 22:01

#1です。

すみません。貼り付けるコードはこちらにしてください。
測定日付が①シートのL1に入っているのを見落としていました。

’-------------------------------------------------------
Sub データ転記()

'変数宣言
Dim k As Integer, r As Integer, c As Integer
Dim Nam As String, Rng As Range
Dim Ws1 As Worksheet, Hiduke As Integer
Set Ws1 = Worksheets(1)

'日付を決める
Hiduke = Ws1.Cells(1, 12)


'データを各個人シートに転記
Application.ScreenUpdating = False
For c = 1 To 6 Step 5
For r = 1 To 15
Ws1.Select
Nam = Cells(r, c).Value

'該当個人のシートを探しに行く
k = 2
Do Until Worksheets(k).Cells(1, 1).Value = Nam
k = k + 1
Loop

'転記するデータをコピー
With Ws1
Set Rng = .Range(.Cells(r, c + 1), .Cells(r, c + 4))
End With

Rng.Copy
Worksheets(k).Cells(Hiduke + 2, 2).PasteSpecial Paste:=xlPasteAll
Next r
Next c
Application.CutCopyMode = False
Application.ScreenUpdating = True

MsgBox Hiduke & "日の転記完了"
End Sub

’---------------------------------------------------

設置したボタンでは、「ボタン１」などとなっていると思いますが、
その上で右クリックして、ボタン名のあたりで左クリックするとボタン名の変更も可能なので
「転記」とかなんでも好きなようにしてください。

ご不明点あればどうぞ。