EXCEL2016 別シートの参加予定表を週間カレンダーに名前で反映させたい

EXCEL2016にて週間カレンダーを何とか作ることが出来たのですが、
個人別シートに記入した参加予定日をカレンダーに反映させる方法がわからないため質問させていただきます。

予め対象者に参加希望日を尋ね、週間予定に集計する作業ですが、
その作業にEXCELが使えればと思い作成をはじめました。
しかし
実際の運用イメージ画像を添付しました。
結合セルは手書きだった頃の名残です。
個人別シートにチェックを入れると週予定シートの該当日に個人名が載るようにしたいと思っています。
個人名はシート名からでも任意のセルからでもかまいません。
日によっては３人分の名前が載っていたり一人分だったりします。
やりたいことは思いつくのですが、実力が伴わず途方に暮れています。
アドバイスよろしくお願いいたします。

質問者からの補足コメント

• 

  説明不足で申し訳ありません。
  補足させていただきます。
  
  週予定シートのA列及び１行目は文字列です。
  ２行目にはB2に
  『=FLOOR(DATE(A29,A30,-1),7)+7*(A31-1)+2』
  と入力し、D2以降には
  『=B2+1』『=D2+1』･･･と入力しています。
  A29が年、A30が月、A31が何周目か記入しています。
  
  名前の件ですが、フルネームで入れることができたらと思っています。
  個人別シートのB1：C1の結合セルにフルネームを記入し、
  週予定シートに参照できればと。
  
  わかりづらくて申し訳ありませんでした。

  No.2の回答に寄せられた補足コメントです。 補足日時：2020/04/10 17:51

• 

  質問者です。
  
  VBAの標準モジュールにご教示いただいた内容を記載しマクロの実行をしたのですが、反応がありませんでした。
  エラーもでておりません。マクロのセキュリティを「すべてのマクロを有効にする」にしても変わりませんでした。
  何か初歩的なミスをしているのかもしれませんが、VBAは初心者のため解決できそうにありません。
  もしよろしければ補足をお願いいたします。

  
  No.4の回答に寄せられた補足コメントです。 補足日時：2020/04/14 10:05

• 

  ありがとうございます。
  「○」の文字をコピーして統一させることで週予定シートに反映させることができました。
  しかし今度は別の問題が生じてしまいました。
  
  複数の人が同じ日に「○」をした場合でも、一人分しか表示されませんでした。
  例：４月１日は安土麗さんと阿武銅鑼さんと春区さんの三人が「○」をしたが、週予定シートには安土麗さんしか反映されていない。
  
  週予定シートには、一人目は３行目のセル、二人目は５行目のセル、三人目は７行目のセル・・・といったように表示させるにはどうすればよいでしょうか。
  
  質問ばかりで申し訳ありませんが、よろしくお願いいたします。

  
  No.7の回答に寄せられた補足コメントです。 補足日時：2020/04/16 12:10

No.9 ベストアンサー 回答者： めぐみん_ 回答日時： 2020/04/16 13:55

No.8です。

通常最終行を求めるのには下から上に向かって『値』の入っているセルにぶつかったらと調べるのですが、こちらも当初最終行の次の行を得るのにちょっと手こずって補正はしたつもりでしたが、お互いの仕様の違いがあるのかもしれませんね。

なので今回は上から値が入っていないセルを探す旅をさせてみましたので、過去のコードは消していただいてこちらを貼り付けてください。
"〇" については先日回答したようにそちらの環境に調整願います。

Sub megu_2()
Dim rd As Range, rs As Range, r As Range
Dim sn As Integer, s_day As Integer, e_day As Integer
Dim rr As Long, c As Integer
Dim i As Integer, s_mon As Integer, st As String

s_day = 100: e_day = -1
st = "月火水木金土"

With Worksheets("週予定")

s_mon = .Range("A30").Value

For i = 2 To 12 Step 2
Set rd = .Cells(2, i)

If Month(rd.Value) = s_mon Then
s_day = IIf(Day(rd.Value) < s_day, Day(rd.Value), s_day)
e_day = IIf(Day(rd.Value) > e_day, Day(rd.Value), e_day)
End If

Next
Set rd = Nothing

s_mon = IIf(s_mon < 4, (s_mon + 9) * 2, (s_mon - 4) * 2)

For sn = 2 To Worksheets.Count
Set rs = Worksheets(sn).Range("A3").Offset(s_day - 1, s_mon).Resize(e_day - s_day + 1)

If WorksheetFunction.CountIf(rs.Offset(, 1), "〇") > 0 Then
For Each r In rs
c = InStr(st, Format(r.Value, "aaa")) * 2
rr = 3
If r.Range("B1").Value = "〇" Then
If .Cells(3, c).Value = "" Then
.Cells(3, c).Value = Worksheets(sn).Range("B1").Value
Else
Do
rr = rr + 2
Loop Until .Cells(rr, c).Value = ""
.Cells(rr, c).Value = Worksheets(sn).Range("B1").Value
End If
End If

Next
End If

Set rs = Nothing
Next
End With

End Sub

この回答へのお礼

早速のご対応ありがとうございました。
新しいコードを貼り付けたところ、２名以降も反映されました。
当初想定していた形を実現することができ、感激しております。
これから実在の人物と予定で試験運用を始めたいと思います。
この度はありがとうございました。

お礼日時：2020/04/20 09:59

No.8 回答者： めぐみん_ 回答日時： 2020/04/16 13:33

No.7に対する補足について。

こちらではキチンと重複にも対応しきれているのですが・・・

少しやり方の変更を検討してみます。

No.7 回答者： めぐみん_ 回答日時： 2020/04/14 10:56

No.4の補足に対して。

エラーもでず転記もされないって事でしょうか。

幾つか懸念していた件はあったのですけどエラーが発生せず何も起きないってのは、

＞If WorksheetFunction.CountIf(rs.Offset(, 1), "〇") > 0 Then
　～
＞If r.Range("B1").Value = "〇" Then

個人別の予定に書き込んでいる"〇"の記載している文字コードとセルに入力した文字コードが違う場合であれば転記処理は飛ばされるので、エラーも出ず何も変化がないと思われます。
この場合 〇 をセルを選択すると数式を入れる所に表示されるでしょうから、その 〇 をカーソルで選択してコピーし上記の２つの 〇 を消して貼り付け（上書きでも良いです）してみて下さい。

No.6 回答者： めぐみん_ 回答日時： 2020/04/13 15:01

あ！　こちらって日曜日は記載不要と思っての作成ですが、必要でしたか？

この回答へのお礼

日曜日を抜いた週予定なので大丈夫です。
ありがとうございます。

お礼日時：2020/04/14 09:03

No.5 回答者： めぐみん_ 回答日時： 2020/04/13 14:58

No.4です。

個々のデータのＡ列が４月でしたので、１２月の次に１～３月のデータもあると踏まえて作成してます。
なければないで特に問題にはならないと思いますけど。

No.4 回答者： めぐみん_ 回答日時： 2020/04/13 14:54

No.3です。

・個々の予定欄については該当日に合わせ"〇"を入力
・全てのシートは１つのＢｏｏｋにあり、『週予定』シートが一番左にあるとする
・週予定シートのセルＡ３０を基にその月限定で振り分けを行う

と言う感じですかね。

Sub megu()
Dim rd As Range, rs As Range, r As Range
Dim sn As Integer, s_day As Integer, e_day As Integer, c As Integer
Dim i As Integer, s_mon As Integer, st As String

s_day = 100: e_day = -1
st = "月火水木金土"

With Worksheets("週予定")

s_mon = .Range("A30").Value

For i = 2 To 12 Step 2
Set rd = .Cells(2, i)

If Month(rd.Value) = s_mon Then
s_day = IIf(Day(rd.Value) < s_day, Day(rd.Value), s_day)
e_day = IIf(Day(rd.Value) > e_day, Day(rd.Value), e_day)
End If

Next
Set rd = Nothing

s_mon = IIf(s_mon < 4, (s_mon + 9) * 2, (s_mon - 4) * 2)

For sn = 2 To Worksheets.Count
Set rs = Worksheets(sn).Range("A3").Offset(s_day - 1, s_mon).Resize(e_day - s_day + 1)

If WorksheetFunction.CountIf(rs.Offset(, 1), "〇") > 0 Then
For Each r In rs
c = InStr(st, Format(r.Value, "aaa")) * 2
If r.Range("B1").Value = "〇" Then
Select Case True
Case .Cells(3, c) = ""
.Cells(3, c) = Worksheets(sn).Range("B1").Value
Case Else
.Cells(Rows.Count, c).End(xlUp).Offset(1).Value = Worksheets(sn).Range("B1").Value
End Select
End If

Next
End If

Set rs = Nothing
Next
End With

End Sub

ご検証お願いします。

この回答へのお礼

詳細な記載、ありがとうございます。
検証させていただきます。

お礼日時：2020/04/14 09:02

No.3 回答者： めぐみん_ 回答日時： 2020/04/11 08:37

No.2です。

個人別のＡ列（及び以降の日付列）は文字列なのですか？
日付（シリアル値）ではなく？
日付なら楽なのですけどね。

あと『週』とは前月末及び翌月の月初めは考慮しないと考えてよろしいのでしょうか？
すなわち『週予定』の２行目に表記されている日付（当月分？）だけ考えればよいと？

この回答へのお礼

ご回答ありがとうございます。

個人別シートは現在文字列です。
翌日以降は『=A3+1』と記入しているくらいです。

＞あと『週』とは前月末及び翌月の月初めは考慮しないと考えてよろしいのでしょうか？
＞すなわち『週予定』の２行目に表記されている日付（当月分？）だけ考えればよいと？
ご指摘の通りです。当月分のみ把握したいと考えております。

お礼日時：2020/04/13 10:28

No.2 回答者： めぐみん_ 回答日時： 2020/04/10 13:56

No.1です。

個人別シートのＡ列及び週予定の１～２行目は文字列でしょうか？
または日付で入れてセルの書式設定でそのように表示されているのでしょうか？

あと週予定の方はあくまで当月の月初めからの記載で前月末辺りの表示は不要なのでしょうか？
（確かに個人別には前年度？の３月データはないようですけど、５月になった際には４月末は不要なのか必要なのか・・・？）

＞個人名はシート名からでも任意のセルからでもかまいません。

任意のセルとはＢ１：Ｃ１の結合セル？
入っている値はフルネーム？
必要なのは苗字だけ？（シート名はそんな感じに見えますが？）

No.1 回答者： めぐみん_ 回答日時： 2020/04/09 19:52

＞個人別シートにチェックを入れると週予定シートの該当日に個人名が載るようにしたいと思っています。

これって見た感じは簡単そうに思えますけど、仮にＶＢＡでやるって事だとレベル高めだと思いますよ。
ＶＢＡのご経験があるからこその質問なのかは不明ですけどね。
少なくともチェックボックスの代わりにセルに〇を入れて同じ動きをさせる事が理解して作れる位はね。

この回答へのお礼

回答ありがとうございます。
VBAの経験が無いもので、どこから手を付けていいか迷っています。
チェックボックスにした理由は運用時に楽そうだからという理由なので、「○」でも良かったのです。
VBAの勉強も始めていきたいと思いますので、ご教授いただければと思います。

お礼日時：2020/04/10 09:31