[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『カレンダーの作成』（hana）
カレンダーを作りたいと考えています。
カレンダーの内容は、1ヶ月の訪問スケジュールを作りたいです。
Aさん 月曜,火曜,金曜
Bさん 水曜,土曜
Cさん 月曜
Dさん 火曜,木曜,土曜
という感じのものをsheet１に入力して、sheet２のカレンダーに自動反映
させたいです。
ご教授お願いいたします。
＜ 使用 Excel：Excel2016mac、使用 OS：MacOSX ＞
最低でも、Sheet1 と Sheet2 の具体的なレイアウトぐらいは、そちらから提示すべきではないですか？ それも、回答側に作らせようということですか？
（β） 2017/03/03(金) 17:20
sheet１には
A B C D E F G
１氏名 月 火 水 木 金 土
２Aさん ● ● ●
３Bさん ● ●
４Cさん ● ● ●
という形でどの人に何曜日に行くかがわかるようになっています。
そもそも、この状態ではカレンダーに自動反映させるのは無理なのでしょうか？
（hana） 2017/03/03(金) 17:46
たぶん可能だと思いますよ。マクロでも関数でも。
私が言っているのは、たとえば関数専門家さんが、『カレンダー』なるレイアウトを想像して 別シートに いわゆる 縦横マトリックスのカレンダーのレイアウトがあるという前提で、回答をされた。
そうすると、hanaさんから、説明が遅れましたがカレンダーというのは、別シートの縦に 1日から最終日まで ならんでいるものです。
で、回答側が、そういうレイアウトにして、その日の担当者を、その右の列にでも表示するようにかえた。
そうすると hanaさんから、説明が遅れましたが 担当ごとに列を分けて表示していきたい・・・
といったようなことが延々と繰り返されると、無駄なことになりますよということです。
そもそも
>カレンダーについては、具体的にレイアウトはできていません。
具体的なレイアウトがないものに対して具体的な回答はできませんよ。 仮レイアウトでもいいので、まず hana さんが『責任をもって』提示すべきです。
（β） 2017/03/03(金) 17:52
A B C
1 日 曜日 訪問者
2 １ 月 Aさん, Bさん
3 ２ 火 Aさん,Cさん,Dさん
4 ３ 水 Bさん,Dさん
（hana） 2017/03/03(金) 18:06
本格的な回答は専門家さんからのレスを待ってください。
思い付きですし、また xl2016 を持っていませんし、またxl2016 であっても OS365 とペアかどうかもわかりませんし
それが mac でもサポートされているかもわかりませんが、xl2016 では TEXTJOIN がサポートされているようですので
SHeet1 の I1:N1 に月～土 までいれて
I2: =IF($A2="","",IF(B2="●",$A2,"")) これを N2 までフィルコピーし、そのまま下にフィルコピー
P1:P6 に 月～土 を縦に入れて Q1 : =TEXTJOIN("、",TRUE,OFFSET(H$1:H$1000,0,ROW(A1))) これを下にQ6までフィルコピー。
あとは、Sheet2 の C2 以下の C列に P1:Q6 を参照してVLOOKUP とか。
実際に試してもいませんし、作業領域つかいまくりですが。
（β） 2017/03/03(金) 20:30
>hana さん
マクロを使用していない、関数のみのカレンダー（縦）です。 サンプルファイルを置いておきます。参考にしてください。 http://d.kuku.lu/a0ae19145e 上記ファイルの「E7,G7,H7,I7,J7,K7」を結合してもいいかも。
どのようなカレンダーにしたいか、様式が定まったら、 掲示板にシートレイアウト（シート構成）を記述してください。 こちらでは、面倒なので作成できません。
シートで使用しているセル範囲の 「開始列」「最終列」「開始行」「最終行」 及び、記述内容の概要（いくつかの文字列）が、わかるように。
シートレイアウトを作成するファイル （■シートレイアウト To Text_To ClipBord_02.xls ）を [[20170116012224]] の 2017/03/03(金) 19:47 に置いています。 （マリオ） 2017/03/03(金) 20:41
To マリオさん
これって、hanaさんの要件（Sheet1 の元ネタから SHeet2 に展開）を達成するサンプルではなく、 単に、カレンダーを作るなら、こういうカレンダーにしたらどうかというデザインの提案ですか？
まぁ、それはそれで、結構なんですが、先決問題は、Sheet1 --> Sheet2 であって 見栄えも含めたデザインは、まだまだ先の話では？
（β） 2017/03/03(金) 22:30
To β さん >デザインの提案ですか そうです。Sheet1は、まったく考えてません。単なるSheet2のカレンダーのデザイン案です。 （マリオ） 2017/03/03(金) 23:44
こんにちわ。
TEXTJOINは2016でも365じゃないとサポートされていないっぽいので？ 使えない可能性も考えての作業列を使う方法です。 カレンダーのレイアウトは以下のように年月を指定するセルを追加して、 5行目以下にカレンダー表示にしています。 人の増減はD列より右の作業列を、さらに右にコピペすれば追加出来ますし、 予め多めに右に(Z列までとか)コピペしておいても良いです。
Sheet1のレイアウトは、（hana） 2017/03/03(金) 17:46の通りです。
A B C D E
1 年 2017
2 月 3
3
4 日 曜日 訪問者
5 1 水 Aさん、Cさん Cさん Cさん
6 2 木 Bさん、Cさん Bさん Cさん Cさん
7 3 金 Cさん Cさん Cさん
8 4 土
9 5 日
10 6 月 Aさん
11 7 火 Aさん、Bさん Bさん
12 8 水 Aさん、Cさん Cさん Cさん
13 9 木 Bさん、Cさん Bさん Cさん Cさん
14 10 金 Cさん Cさん Cさん
15 11 土
16 12 日
17 13 月 Aさん
18 14 火 Aさん、Bさん Bさん
19 15 水 Aさん、Cさん Cさん Cさん
20 16 木 Bさん、Cさん Bさん Cさん Cさん
21 17 金 Cさん Cさん Cさん
22 18 土
23 19 日
24 20 月 Aさん
25 21 火 Aさん、Bさん Bさん
26 22 水 Aさん、Cさん Cさん Cさん
27 23 木 Bさん、Cさん Bさん Cさん Cさん
28 24 金 Cさん Cさん Cさん
29 25 土
30 26 日
31 27 月 Aさん
32 28 火 Aさん、Bさん Bさん
33 29 水 Aさん、Cさん Cさん Cさん
34 30 木 Bさん、Cさん Bさん Cさん Cさん
35 31 金 Cさん Cさん Cさん
A5 =DATE(B1,B2,ROW(A1)) 年間カレンダーにしたい時は、B2を1にして下さい。 A6 =A5+1 A列の書式は d B5 =A5 B列の書式は aaa それぞれ下にフィルコピー
C5 =IF(INDEX(Sheet1!$B:$H,COLUMN(A1)+1,WEEKDAY($A5,2))="●",INDEX(Sheet1!$A:$A,COLUMN(A1)+1)&IF(D5="","","、"&D5),D5&"") 右と下にフィルコピー(右は予め多めにコピーするか、人数に合わせて都度コピー)
月間カレンダーの時は、33行目以降は条件付き書式で、 33～35行目全て選択して、 数式に =DAY($A33)<4 フォントの色を白 にして下さい。
式に無駄があったので修正(10:19)
（sy） 2017/03/04(土) 09:52
なるほど！ です。
この関数処理案で解決ということですけど、書いたのでＶＢＡコードを。 SHeet2 は sy さんがアップされたレイアウトにしてあります。
Sample1 は Sheet1 のセルなめまくり。 Sample2 は 行単位、列単位の処理です。
Sub Sample1()
Dim c As Range
Dim dic As Object
Dim wd As String
Dim nm As String
Dim v As Variant
Dim x As Long
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1").Range("A1").CurrentRegion
For Each c In .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1)
If c.Value <> "" Then
wd = c.EntireColumn.Cells(1).Value
nm = c.EntireRow.Cells(1).Value
If Not dic.exists(wd) Then Set dic(wd) = CreateObject("Scripting.Dictionary")
dic(wd)(nm) = True
End If
Next
End With
With Sheets("Sheet2").Range("A3").CurrentRegion
With .Offset(1).Resize(.Rows.Count - 1)
ReDim v(1 To .Rows.Count, 1 To 1)
For Each c In .Columns(2).Cells
x = x + 1
If dic.exists(c.Value) Then v(x, 1) = Join(dic(c.Value).keys, "、")
Next
.Columns(3).Value = v
End With
.Columns(3).AutoFit
.Parent.Select
End With
End Sub
Sub Sample2()
Dim sv As Variant
Dim col As Range
Dim r As Range
Dim z As Variant
Dim c As Range
Dim dic As Object
Dim wd As String
Dim v As Variant
Dim x As Long
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1").Range("A1").CurrentRegion
With .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1)
sv = .Value
For Each r In .Rows
r.Replace "●", r.EntireRow.Cells(1).Value, xlWhole
Next
For Each col In .Columns
wd = col.EntireColumn.Cells(1).Value
z = Filter(Evaluate("TRANSPOSE(IF(" & col.Address & "<>""""," & col.Address & ",CHAR(10)))"), vbLf, False)
If UBound(z) >= 0 Then
dic(wd) = Join(z, "、")
Else
dic(wd) = Empty
End If
Next
.Value = sv
End With
End With
With Sheets("Sheet2").Range("A3").CurrentRegion
With .Offset(1).Resize(.Rows.Count - 1)
ReDim v(1 To .Rows.Count, 1 To 1)
For Each c In .Columns(2).Cells
x = x + 1
v(x, 1) = dic(c.Value)
Next
.Columns(3).Value = v
End With
.Parent.Columns(3).AutoFit
.Parent.Select
End With
End Sub
（β） 2017/03/04(土) 10:15
↑ sy さんの処理案で、存在しない日は色消ししてあり、値はあったんですね。 私のコードは、値があれば、目に見えなくても 訪問者をセットしていますので、ちょこっと変更が必要ですね。
（β） 2017/03/04(土) 10:32
よくよく考えたら作業列が必要なのは11行目までだけでした。
12行目以降は作業列を消して、 C12 =C5 下にフィルコピーにして下さい。
（sy） 2017/03/04(土) 10:58
βさん
Sample2の方は何か結果がおかしいですよ。
マクロならイベントの方が良いですね。 以下のような感じでどうでしょう。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sh As Worksheet
Dim s(1 To 7) As String
Dim i As Integer
Dim k As Integer
If Intersect(Target, Range("B1:B2")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Set sh = Sheets("Sheet1")
'曜日ごとの訪問者を変数に格納
For i = 1 To 7
For k = 2 To sh.Range("A" & Rows.Count).End(xlUp).Row
If sh.Range("B:H").Columns(i).Rows(k).Value = "●" Then
s(i) = s(i) & "、" & sh.Range("A:A").Rows(k).Value
End If
Next k
s(i) = Mid(s(i), 2)
Next i
'日付と曜日をセット
With Range("A5:C35")
.ClearContents
.Columns(1).Formula = "=IF(MONTH(DATE(B$1,B$2,ROW(A1)))<>B$2,"""",ROW(A1))"
.Columns(2).Formula = "=IF(MONTH(DATE(B$1,B$2,ROW(A1)))<>B$2,"""",TEXT(DATE(B$1,B$2,ROW(A1)),""aaa""))"
.Value = .Value
End With
'曜日ごとの訪問者をセット
For i = 5 To 35
If Cells(i, "A").Value = "" Then Exit For
Cells(i, "C").Value = s(InStr("月火水木金土日", Cells(i, "B").Value))
Next i
Application.EnableEvents = True
End Sub
（sy） 2017/03/04(土) 12:05
>Sample2の方は何か結果がおかしいですよ。
えっ？ そうですか（汗） 調べてみますけど、どのようにおかしかったですか？
>マクロならイベントの方が良いですね。
マリオさんの好きなイベント処理ですね。
でもイベント処理をするなら Sheet1 側の変更もキャッチしないと、Sheet2 は なんの変化もおきないですよ。
（β） 2017/03/04(土) 12:19
↑ あっ！！
わかりました。
コードを作っていて、急きょ syさんレイアウトに合わせてアップして、そのあと試してみたら ぐちゃぐちゃになっていて、わぁ！！ ということで、直して、よし、できた！
でもアップしないまま、しかも保存しないで閉じたので、あとかたもなくなっていて。
いずれにしても、マクロ案は用済みでしょうけど、時間があれば もう一度、直して、アップします。
★それまでは Sample2 は 捨ておいてください。
（β） 2017/03/04(土) 12:25
>Sheet1 側の変更もキャッチしないと、Sheet2 は なんの変化もおきないですよ。 あっ、、、失念してました。
まぁでもSheet1は頻繁に変更は無いと思うので、Sheet1に 「Sheet2の年または月を変更しないと変更は反映されません。」 などの注意書きを書いておくだけで行けるんじゃないかと思います。
（sy） 2017/03/04(土) 12:36
>βさん sample1とsample2は、下記のレイアウトで使用できますか？ sample1とsample2、両方、試したのですが、 Sheet2のC4の訪問者の文字列が消えるだけでした。 何処が間違ってますかね？
■Sheet1
|[A] |[B]|[C]|[D]|[E]|[F]|[G]|[H]
[1]|氏名 |月 |火 |水 |木 |金 |土 |日
[2]|Aさん|● |● |● | | | |
[3]|Bさん| |● | |● | | |
[4]|Cさん| | |● |● |● | |
■Sheet2
|[A]|[B] |[C]
[1] |年 |2017|
[2] |月 | 3|
[3] | | |
[4] |日 |曜日|訪問者
[5] | 1|水 |
[6] | 2|木 |
[34]| 30|木 | [35]| 31|金 | （マリオ） 2017/03/04(土) 12:54
マリオさん と βさん
私の関数でのレイアウトを、そのまま使用したらβさんのコードは空白になりますね。 関数レイアウトでは書式で曜日にしてるだけで実際は日付が入っているので、
βさんのコードは、Sheet1の1行目の曜日の文字を読込んで、Sheet2のB列の曜日と比較してるので、 Sheet2のB列も文字じゃないと駄目ですね。
そっか。私が試した時は、私のコードを実行した後で、曜日が文字になってたから正しく表示されたのか。
後、訪問者の文字が消えるのは
>With Sheets("Sheet2").Range("A3").CurrentRegion
この起点のセルがA3になってるからですね。
A4に直せば消えないです。
（sy） 2017/03/04(土) 13:41
sheet2のカレンダーの方ですが、syさんからご教授いただいたものを使わせていただいていますが、
Ａ B C D E ５１ 水 Aさん Bさん Cさん ６２ 木 Aさん Bさん Cさん ７３ 金 Bさん Cさん ８４ 土 Aさん Cさん
のように、1日水曜の場合、AさんをC6のセルに、BさんをD6のセルに、CさんをE6のセルに…
ということは可能でしょうか？
（hana） 2017/03/04(土) 16:03
syさんの関数案でいかれることですし（私もそれがベストだと思います）また、そのレイアウトで 曜日ではなく、日付が書式で入っているといったところへのチューニングも（もしＶＢＡを使うなら） 必要ですが、（１か所 Value を Text に変更するだけですが）そういったことは、捨ておきましょう。
でも、間違いコードを、そのままにしておくのは恥ずかしいので。。
Sample2 の With Sheets("Sheet2").Range("A3").CurrentRegion は皆さんご指摘の通り
With Sheets("Sheet2").Range("A4").CurrentRegion
もう一か所、シート関数を使っているところの領域記述でシート名が抜けていました。
z = Filter(Evaluate("TRANSPOSE(IF(" & col.Address & "<>""""," & col.Address & ",CHAR(10)))"), vbLf, False)
これは、
z = Filter(Evaluate("TRANSPOSE(IF(" & col.Address(External:=True) & "<>""""," & col.Address(External:=True) & ",CHAR(10)))"), vbLf, False)
でしたね。
（β） 2017/03/04(土) 17:25
>sy さん
（sy） 2017/03/04(土) 12:05 は、 Sheet2シートのコード記述欄に貼り付けて、 Sheet2の「B1の年または、B2の月」 が変更されたときに動作するｺｰﾄﾞですね。 これで、十分ですね。
■Sheet2の記載は、これだけですね。
|[A]|[B] |[C]
[1] |年 |2017|
[2] |月 | 3|
[3] | | |
[4] |日 |曜日|訪問者
> βさん syさんの >>関数レイアウトでは書式で曜日にしてるだけで実際は日付が入っているので、 で気づきましたが、
Sample1ですが、Sheet2のA5,B5以降に■数式を入れているなら、 ★箇所のようにした方がいいかも、と思いました。
Dim s As String '★
With Sheets("Sheet2").Range("A4").CurrentRegion'☆A4に変更
With .Offset(1).Resize(.Rows.Count - 1)
ReDim v(1 To .Rows.Count, 1 To 1)
For Each c In .Columns(2).Cells
x = x + 1
s = Format(c.Value, "aaa") '★
If dic.exists(s) Then v(x, 1) = Join(dic(s).keys, "、") '★
Next
.Columns(3).Value = v
End With
.Columns(3).AutoFit
.Parent.Select
End With
（マリオ） 2017/03/04(土) 18:36
To マリオさん
添削深謝。ただ、何度もコメントしているように、マクロでの対処は（本質問に関しては）必要がないので これ以上の、数式レイアウト対応は、すればするだけ、質問者さんが混乱し、回答者どうしで楽しんでいる雰囲気になって できれば、打ちきりにしたいです。
といいながら、口の根もかわかないのに、イベント処理のことにふれますと、
>これで、十分ですね。
それは、回答者サイドで判断することではありません。
もし、このSheet1,SHeet2 の運用手順が
・まず、Sheet1 側のデータを確定させる。アサインするほう、されるほう、さっと決まる場合もあるでしょうし いやぁ、その日は勘弁してくれとか、申し訳ないけど、この日、当番になってくれとか、確定までには 結構な日数を費やすかもしれない、 で確定後、最終成果物として、やおら、SHeet2を開いて、年月をいれる。
この場合は SHeet2 の年月入力起動がいいかもしれない。
あるいは
・たとえば、今であれば、2017/4 の予定を組もうとする。で、とりあえず、Sheet2 のカレンダー枠を作っておく。 しかる後に、アサインするほう、アサインされるほうで、かんかんがくがく、やりとりしながら、予定を入れたり 変更したり。きっと 3/20ぐらいまでには、話がまとまり、Sheet1 が確定する。 もしかしたら、3/31 ぎりぎりに、ある担当者が不承不承、アサインを受け入れ、記入追加するかもしれない。
この場合は、Sheet2 のカレンダー枠はできてしまっているので、いまさら、もう一度 2017/4 とは入れなおさない。
といった、流れ、どちらなのか、あるいは、また別の流れなのか。 そういったことは 質問者さんしかわからないことで、回答側で【十分ですね】というべきものではないと思いますよ。
（β） 2017/03/04(土) 19:04
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.