VBAの勤務割表の式を短く

2012/10/08 14:46

このQ&Aのポイント

VBAを使用して勤務割表を作成している際、セルの入力番号に応じて個人の勤務の割り振り状態を表示するために、短い式を作成したいとの質問です。
具体的には、1列3行を一枡とし、日付を列に、個人名を行にして、個人・日ごとの勤務の割り振りを表示する勤務割表を作成しています。
名前の定義は、1行3列に「1-」で勤務1、「-」で日勤、「公休」で公等にしてあります。質問者はVBAの知識が不足しているため、式を簡単にする方法を知りたいと思っています。

VBAの勤務割表の式を短く

　月間の勤務割表を作成しています。 1列3行を一枡として一人・一日の枡とし、勤務の割り振り状態を表示するものです。列に日付、行を個人名（max16名）とし1列3行を名前の定義で13種類作成してあります。別シートの各セルの入力番号に応じて13種類を貼り付けていますが、式を簡単にできませんでしようか？　お教えくださいませんでしょうか？勉強不足は否めませんが。尚名前の定義は、1行3列に1－－で勤務1・""-""で日勤・""公休""で公等にしてあります。 OS Windows7 Office2010 Sub 図形の貼付け2() If Worksheets("メイン").Range("J9").Value Then Select Case Worksheets("メイン").Range("J9").Value 1人－1日 Case 1: ActiveSheet.Range("勤務１").Select Selection.Copy Range("D10").Select ActiveSheet.Paste Application.CutCopyMode = False Case 2: ActiveSheet.Range("勤務2").Select Selection.Copy Range("D10").Select ActiveSheet.Paste Application.CutCopyMode = False Case 3: ActiveSheet.Range("勤務3").Select Selection.Copy Range("D10").Select ActiveSheet.Paste Application.CutCopyMode = False Case 4: ActiveSheet.Range("日勤1").Select Selection.Copy Range("D10").Select ActiveSheet.Paste Application.CutCopyMode = False Case 5: ActiveSheet.Range("日勤2").Select Selection.Copy Range("D10").Select ActiveSheet.Paste Application.CutCopyMode = False Case 6: ActiveSheet.Range("日勤3").Select Selection.Copy Range("D10").Select ActiveSheet.Paste Application.CutCopyMode = False End Select Else Select Case Worksheets("メイン").Range("I9").Value Case 2: ActiveSheet.Range("明け").Select Selection.Copy Range("D10").Select ActiveSheet.Paste Application.CutCopyMode = False Case 4: ActiveSheet.Range("夜勤").Select Selection.Copy Range("D10").Select ActiveSheet.Paste Application.CutCopyMode = False Case 5: ActiveSheet.Range("公").Select Selection.Copy Range("D10").Select ActiveSheet.Paste Application.CutCopyMode = False Case 6: ActiveSheet.Range("有").Select Selection.Copy Range("D10").Select ActiveSheet.Paste Application.CutCopyMode = False Case 7: ActiveSheet.Range("特").Select Selection.Copy Range("D10").Select ActiveSheet.Paste Application.CutCopyMode = False Case 8: ActiveSheet.Range("振").Select Selection.Copy Range("D10").Select ActiveSheet.Paste Application.CutCopyMode = False Case 9: ActiveSheet.Range("欠").Select Selection.Copy Range("D10").Select ActiveSheet.Paste Application.CutCopyMode = False End Select End If End Sub