Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

39877 / 76732

←次へ　｜　前へ→


	【41959】Re:教えてください

Kein - 06/8/27(日) 2:16 -


	引用なし

	パスワード

そのようにすると「必ず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

0 hits

▼

【41958】教えてください 超初心者 06/8/27(日) 1:26