Excel VBA質問箱 IV

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

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


39883 / 76738 ←次へ | 前へ→

【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 質問
【41959】Re:教えてください Kein 06/8/27(日) 2:16 回答
【41963】Re:教えてください T 06/8/27(日) 10:09 質問
【41965】Re:教えてください かみちゃん 06/8/27(日) 10:36 発言
【41968】Re:教えてください T 06/8/27(日) 11:30 お礼
【41967】Re:教えてください Hirofumi 06/8/27(日) 11:18 回答

39883 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free