スケジュール表の作り方 VBA

スケジュール表のフォームをを作りたいと考えています。
２種類ほど反映させたいため、複雑になってしまい、調べてもわからず、可能かどうかわからないのですが、もし得意な方がいれば教えていただきたいです。よろしくお願いいたします。


①月間カレンダー（表型）の作成
・午前と午後で分かれている（添付したような感じ）

②週間カレンダーの作成
・午前と午後で分かれている
・日付、場所、内容が記載されている

行いたいこと
❶
①のカレンダーに特定の数字を入れて、文字変換させたい
例）1と入力したら、実技と表示される。2と入力したら、座学と入力される

❷
①のカレンダーに”１”→”実技”と表示されたものをさらに違う表示方法で②のカレンダーに反映させたい。
例）①に”１”→”実技”、②のカレンダーの場所のセルに”研究室１”と表示させたい。
この時、常に場所は同じです。


このように少し複雑な形ではありますが、毎月、エクセルで行うと日付を変えたり、何度も入力して、となるので、いい方法があれば是非教えてください。

どうぞよろしくお願い致します。

No.1 回答者： tom04 回答日時： 2018/06/11 20:52

こんにちは！

①について
↓の画像のような感じでSheet1に作成してみました。
A1セルに「西暦年」、C1セルに「月」の数値を入れるとします。
A3セル（セルの表示形式はユーザー定義から　mmm　としています）に
=DATE(A1,C1,1)
という数式を入れています。
B4セル（セルの表示形式はユーザー定義から　 d　としています）に
=IF(MONTH($A$3-WEEKDAY($A$3,2)+COLUMN(A1)+7*(ROW(A3)/3-1))=MONTH($A$3),$A$3-WEEKDAY($A$3,2)+COLUMN(A1)+7*(ROW(A3)/3-1),"")

という数式を入れ、B4～B6セルを範囲指定　→　B6セルのフィルハンドルで右へコピー　→　そのまましたへ3行ずつフィル＆コピーしています。

これでA1・C1の数値を入れ替えるだけでその月のカレンダーが作成できます。
Sheet2の方には、まず「実技」と「研究室1」の対応表をJ・K列に作成しています。
（今後Sheet1に入力する「1・2」が増えても対応できます）
そして
A1は
=Sheet1!A1
C1は
=Sheet1!C1
B4は
=Sheet1!B4
（B4セルまではリンク貼り付けと同じことです）

B5セルに
=IF(Sheet1!B5="","",VLOOKUP(Sheet1!B5,$J:$K,2,0))
という数式を入れ下のB6セルまでフィル＆コピー！
最後にSheet2のB4～B6セルを範囲指定　→　Sheet1と同じように右へ下へ（下は3行ずつ）フィル＆コピー！

これでカレンダーの作成は完了です。
以上で　❷　までの下準備はできました。

②　に関しては詳細が不明ですので手を付けていません。

❶　については関数では無理なので、VBAになります。
画面左下の「Sheet1」のシート見出し上で右クリック　→　コードの表示　→　VBE画面のカーソルが点滅しているところに
↓のコードをコピー＆ペースト　→　Excel画面に戻り
Sheet1のカレンダー日付の下の2行（午前・午後の行）に　1　もしくは　2　を入力してみてください。

Private Sub Worksheet_Change(ByVal Target As Range) '//この行から//
　Dim c As Range, myRng As Range, myAry

　　myAry = Array("実技", "座学")
　　Set myRng = Range("B5:H6,B8:H9,B11:H12,B14:H15,B17:H18,B20:H21")
　　　If Intersect(Target, myRng) Is Nothing Then Exit Sub
　　　　For Each c In Target
　　　　　If c <> "" Then
　　　　　　Application.EnableEvents = False
　　　　　　　Target = myAry(Target - 1)
　　　　　　Application.EnableEvents = True
　　　　　End If
　　　　Next c
End Sub '//この行まで//

※　一発で解決！とはいかないと思いますが、
まずはこの程度で・・・m(_ _)m