|
そのようにすると「必ず1月のデータから入力していく必要がある」ので
ちょっと不便ではないかと思われます。マクロを起動したときに、まず
InputBox を出して月の数値(1〜12)を入力し、その月の列にデータを
入力していくようにしたら良いでしょう。
既にメインシートと各人のシートの表組みが出来ているとして、
各人のシート名は各人の名前であることを前提に、メインシートの
シートモジュールに以下のようなイベントマクロを入れて下さい。
最後の体脂肪率を入力したとき、自動的にその行の
名前, 体重, 血圧高, 血圧低, 体脂肪率 が入力されているかチェックし、
名前に一致するシートの指定した月の列にデータを転記します。
Private Sub Worksheet_Change(byVal Target As Range)
Dim MyR As Range
Dim Wf As WorksheetFunction
Dim Mnum As Integer
Dim Snm As String
Dim MyV As Variant, Col As Variant
Set MyR = Range("A2", Range("A65536").End(xlUp)).Offset(, 4)
Set Wf = Application.WorksheetFunction
If Intersect(Target, MyR) Is Nothing Then GoTo ELine
With Target
If .Count > 1 Then GoTo ELine
If IsEmpty(.Value) Then GoTo ELine
If Wf.Count(.Offset(, -3).Resize(, 4)) < 4 Then GoTo ELine
Snm = .Offset(, -4).Value
If Snm = "" Then GoTo ELine
MyV = Wf.Transpose(.Offset(, -3).Resize(, 4).Value)
End With
Do
Mnum = Application _
.InputBox("入力する月を 1〜12 の数値で入力して下さい", Type:=1)
If Mnum = 0 Then GoTo ELine
Loop While Mnum < 0 Or Mnum > 12
On Error GoTo ELine
With Worksheets(Snm)
Col = Application.Match(Mnum & "月", .Rows(1), 0)
If IsError(Col) Then GoTo ELine
With .Cells(2, Col).Resize(4)
.ClearContents
.Value = MyV
End With
End With
ELine:
Set MyR = Nothing: set Wf = Nothing
End Sub
|
|