Results of 1 - 1 of about 1238 for カレンダー (0.001 sec.)
- [[20170228130843]]
- #score: 6148
- @digest: 264accc1b2e93190cdea563bd6f7e98a
- @id: 72830
- @mdate: 2017-03-03T00:30:25Z
- @size: 22155
- @type: text/plain
- #keywords: 用カ (135985), 程!$ (76514), s55tac (50119), 程") (45547), ー_ (40096), 示用 (38235), tsh (36663), 縦") (34779), 発" (34454), 日程 (31731), （s5 (26192), 会議 (26081), カレ (23509), 議1 (23453), msh (22358), 議2 (22075), レン (14630), ンダ (12897), ダー (11949), 議室 (11091), 2017 (10182), シ様 (8917), 中" (8562), ウッ (7675), xlwhole (7509), 業中 (7145), 業1 (6726), ッシ (5212), usedrange (5097), nothing (4842), ー") (4540), 開発 (4421)
- 『一覧表をカレンダー表示へ変換』（s55tac）
会議スケジュールの一覧を、カレンダー表示に自動変換をしたいのですが、 行き詰ってしまいまして、皆様の知恵をお貸し頂きたく存じます。 よろしくお願い申し上げます。 シート「日程」の A列:重要度が【A】かつ、C列:期間が【長】となっている 作業のみ、各会議の各日程が、シート「カレンダー」の該当する日にちのセルに対して 作業名 会議名 の表記で入力されるようにしたいです。 なお、同じ日に会議が重なった場合は、会議の列が左側の方をカレンダーで 上側に来るように表示させたいです。 よろしくお願いします。 シート:日程 重要度 作業名 期間 会議1 会議2 会議3 会議4 A 作業1 長 2017/5/1 2017/5/10 2017/5/19 2017/5/30 B 作業2 短 2017/5/3 2017/5/10 2017/5/16 2017/5/25 A 作業3 長 2017/5/5 2017/5/15 2017/5/30 2017/6/10 C 作業4 長 2017/5/10 2017/5/30 2017/6/7 2017/6/12 A 作業5 中 2017/5/2 2017/5/10 2017/5/16 2017/5/26 A 作業6 長 2017/5/3 2017/5/25 2017/6/14 2017/6/26 シート:カレンダー 月 火 水 木 金 2017/5/1 2017/5/2 2017/5/3 2017/5/4 2017/5/5 作業1 作業6 作業3 会議1 会議1 会議1 2017/5/8 2017/5/9 2017/5/10 2017/5/11 2017/5/12 作業1 会議2 2017/5/15 2017/5/16 2017/5/17 2017/5/18 2017/5/19 作業3 作業1 会議2 会議3 2017/5/22 2017/5/23 2017/5/24 2017/5/25 2017/5/26 作業6 会議2 2017/5/29 2017/5/30 2017/5/31 2017/6/1 2017/6/2 作業3 会議3 作業1 会議4 よろしくお願いします。 ＜ 使用 Excel:Excel2010、使用 OS:Windows7 ＞ ---- こんにちは カレンダーシートの日付は入力済として、同じ列に7日おきに日付が入っていて、 日程シート決定後に一括処理するなら、 Sub test() Dim mSh As Worksheet Dim tSh As Worksheet Dim f As Range Dim s As Range Dim i As Long Dim j As Long Dim e As Long Set mSh = Worksheets("日程") Set tSh = Worksheets("カレンダー") Application.ScreenUpdating = False With mSh e = .Range("A1").CurrentRegion.Rows.Count For i = 4 To 7 For j = 2 To e If .Cells(j, 1) = "A" And .Cells(j, 3) = "長" Then Set f = tSh.UsedRange.Find(.Cells(j, i), , , xlWhole) If Not f Is Nothing Then Set s = tSh.UsedRange.Find(.Cells(j, i) + 7, , , xlWhole) If s Is Nothing Then Set s = tSh.Cells(Rows.Count, f.Column).End(xlUp).Offset(1) Else Set s = s.End(xlUp).Offset(1) End If s.Value = .Cells(j, 2) s.Offset(1).Value = .Cells(1, i) End If Set f = Nothing Set s = Nothing End If Next Next End With Application.ScreenUpdating = True End Sub こんな感じで。 （ウッシ） 2017/02/28(火) 14:37 ---- こんにちは 日付の行間数調節するように変更しました。 Sub test1() Dim mSh As Worksheet Dim tSh As Worksheet Dim f As Range Dim s As Range Dim t As Range Dim i As Long Dim j As Long Dim e As Long Set mSh = Worksheets("日程") Set tSh = Worksheets("カレンダー") Application.ScreenUpdating = False With mSh e = .Range("A1").CurrentRegion.Rows.Count For i = 4 To 7 For j = 2 To e If .Cells(j, 1) = "A" And .Cells(j, 3) = "長" Then Set f = tSh.UsedRange.Find(.Cells(j, i), , , xlWhole) If Not f Is Nothing Then Set s = tSh.UsedRange.Find(.Cells(j, i) + 7, , , xlWhole) If s Is Nothing Then Set t = tSh.Cells(Rows.Count, f.Column).End(xlUp).Offset(1) Else If s.Offset(-1).Value <> "" Then s.Resize(2).EntireRow.Insert Set t = s.Offset(-2) Else Set t = s.End(xlUp).Offset(1) If s.Row - t.Row = 1 Then t.EntireRow.Insert Set t = t.Offset(-1) t.Select Else End If End If End If t.Select t.Value = .Cells(j, 2) t.Offset(1).Value = .Cells(1, i) End If Set f = Nothing Set s = Nothing Set t = Nothing End If Next Next End With Application.ScreenUpdating = True End Sub （ウッシ） 2017/02/28(火) 15:11 ---- > ウッシ様 早速のコメントありがとうございます。 ただ、関数だけで何とかなるかと思っていたので、 最初に提示させていただいた内容はかなり簡略化したものでした。 自分で細かいところは置き換えて調整できるかと思っていたのですが、 マクロやVBAは不慣れなもので、うまく動きませんでした。 また、同じ日に会議が重なった場合は、会議の列が左ではなくて右側の方をカレンダーで 上側に来るように表示させたいです。 具体的なExcelファイルを以下にUPしましたので、二度手間になってしまい申し訳ないのですが、 もう少し詳しく教えていただけませんでしょうか。 http://dtbn.jp/NhnHKd6 よろしくお願いいたします。 （s55tac） 2017/02/28(火) 17:30 ---- 具体的なExcelファイルをYahooボックスにUPし直しました。 http://yahoo.jp/box/VFyL0k 以下、改めて条件を記載します。 シート:日程のG列:種別が‘開発'かつJ列状況が‘作業中'となっている プロジェクトのみ、K列:日程が‘見込'の行の各会議の各日程が、 シート「表示用カレンダー」の該当する日にちのセルに対して テーマ名 会議名 で入力されるようにしたいです。 同じ日に会議が重なった場合は、会議の列が右側の方を カレンダーの日にちのセルで上側に来るように表示させたいです。 文章で書くと解り辛いかもしれないので、画像に説明を追加しました。 http://yahoo.jp/box/Z-zjEX よろしくお願いいたします。 （s55tac） 2017/02/28(火) 22:12 ---- こんばんは やけに複雑になってますね。 Sub test2() Dim mSh As Worksheet Dim tSh As Worksheet Dim f As Range Dim s As Range Dim i As Long Dim j As Long Dim e As Long Set mSh = Worksheets("日程") Set tSh = Worksheets("表示用カレンダー") ' Set tSh = Worksheets("表示用カレンダー_縦") Application.ScreenUpdating = False With mSh e = .Range("K" & Rows.Count).End(xlUp).Row For i = 23 To 12 Step -1 For j = 5 To e Step 4 If .Cells(j - 2, 7).Value = "開発" And _ .Cells(j - 2, 10).Value = "作業中" And _ IsDate(.Cells(j, i)) = True Then Set f = tSh.UsedRange.Find(.Cells(j, i), , , xlWhole) If Not f Is Nothing Then Set s = tSh.UsedRange.Find(.Cells(j, i) + 7, , , xlWhole) If s Is Nothing Then Set s = tSh.Cells(Rows.Count, f.Column).End(xlUp).Offset(1) ' Application.Goto s, True ' Stop Else Set s = s.End(xlUp).Offset(1) ' Application.Goto s, True ' Stop End If s.Value = .Cells(j - 2, 8) & vbLf & .Cells(2, i) ' Stop End If Set f = Nothing Set s = Nothing End If Next Next End With Application.ScreenUpdating = True End Sub （ウッシ） 2017/02/28(火) 22:53 ---- 関数での抽出ですが、厳密な表の構成が解りませんので というより面倒なので、コピーできる汎用的な式ではありません。 表に合わせて修正してください。 シート「カレンダー」の日付は入力されているものとします。 日付「2017/5/1〜2017/5/5」までの式です。 A3: =IFERROR(INDEX(日程!$B$2:$B$7,SMALL(IF((日程!$A$2:$A$7="A")*(日程!$C$2:$C$7="長")*(日程!$D$2:$G$7=A$2),ROW($A$1:$A$6),""),1)),"") 「Ctrl + Shift + Enter」キーで式を入力します。（配列数式） A4: =IF(A3="","",INDEX(日程!$D$1:$G$1,MATCH(A$2,INDEX(日程!$D$2:$G$7,MATCH(A$3,日程!$B$2:$B$7,0),)))) 2つの式をE列までコピーします。 A3の式をA5に、A4の式をA6にコピーしてA5の式を修正（1→2）して「Ctrl + Shift + Enter」キーで 式を入力します。 A5: =IFERROR(INDEX(日程!$B$2:$B$7,SMALL(IF((日程!$A$2:$A$7="A")*(日程!$C$2:$C$7="長")*(日程!$D$2:$G$7=A$2),ROW($A$1:$A$6),""),2)),"") ↑ここ A5とA6の式をE列までコピーします。 作業と会議室の組み合わせが1日あたり3つ以上ある場合には、この操作を 繰り返します。 他の週についても同じように上の操作を繰り返します。 面倒かな? （メジロ） 2017/03/01(水) 10:36 ---- こんにちは 「作業と会議室の組み合わせが1日あたり3つ以上ある場合」 を考慮すると、「表示用カレンダー_縦」シートの方が処理しやすいので、 そちらにデータセットするようにします。 Sub test3() Dim mSh As Worksheet Dim tSh As Worksheet Dim f As Range Dim s As Range Dim t As Range Dim i As Long Dim j As Long Dim e As Long Set mSh = Worksheets("日程") Set tSh = Worksheets("表示用カレンダー_縦") Application.ScreenUpdating = False With mSh e = .Range("K" & Rows.Count).End(xlUp).Row For i = 23 To 12 Step -1 For j = 5 To e Step 4 If .Cells(j - 2, 7).Value = "開発" And _ .Cells(j - 2, 10).Value = "作業中" And _ IsDate(.Cells(j, i)) = True Then Set f = tSh.UsedRange.Find(.Cells(j, i), , , xlWhole) If Not f Is Nothing Then Set s = tSh.UsedRange.Find(.Cells(j, i) + 7, , , xlWhole) Application.Goto s, True If s Is Nothing Then Set t = tSh.Cells(Rows.Count, f.Column).End(xlUp).Offset(1) Application.Goto t, True Else If s.Offset(-3).Value <> "" Then s.Offset(-3).Resize(3).EntireRow.Copy s.EntireRow.Insert s.Offset(-3).Resize(3).EntireRow.ClearContents With s.Offset(-3).EntireRow.Range("B1:H1").Borders(xlEdgeTop) .LineStyle = xlDash .Weight = xlHairline End With Set t = s.Offset(-3) Else Set t = s.End(xlUp).Offset(1) Application.Goto t, True If s.Row - t.Row = 1 Then t.EntireRow.Insert Set t = t.Offset(-1) Application.Goto y, True End If End If End If Application.Goto t, True t.Value = .Cells(j - 2, 8) & vbLf & .Cells(2, i) End If Set f = Nothing Set s = Nothing Set t = Nothing End If Next Next End With Application.ScreenUpdating = True End Sub （ウッシ） 2017/03/01(水) 11:36 ---- > メジロ様 ありがとうございます。 VBAとパラで共に検討させていただきます。 （s55tac） 2017/03/01(水) 22:16 ---- ウッシ様 色々とありがとうございます。 ご教示いただいた内容を基に、自分で少し手を加えたのですが、 もう少し教えていただけませんでしょうか。 カレンダーは「表示用カレンダー」を2年から3年に増やしました。 「日程」シートの日にちを修正することを想定し、「表示用カレンダー」シートを 開く毎に、カレンダーを一度クリアして書き込むようにしたつもりです。 ですが、各月の最終週にだけうまく書き込まれません。 どこがおかしいのか、お判りになりましたらお教えいただけませんでしょうか。 Private Sub Worksheet_Activate() Dim mSh As Worksheet Dim tSh As Worksheet Dim f As Range Dim s As Range Dim i As Long Dim j As Long Dim e As Long Set mSh = Worksheets("日程") Set tSh = Worksheets("表示用カレンダー") ' Set tSh = Worksheets("表示用カレンダー_縦") '===================カレンダーをクリア===================== With tSh For i = 5 To 53 Step 10 .Range("B" & i & ":CR" & i + 6).Value = "" Next i For i = 58 To 106 Step 10 .Range("B" & i & ":CR" & i + 6).Value = "" Next i For i = 111 To 159 Step 10 .Range("B" & i & ":CR" & i + 6).Value = "" Next i End With '========================================================== Application.ScreenUpdating = False With mSh e = .Range("K" & Rows.Count).End(xlUp).Row For i = 23 To 12 Step -1 For j = 5 To e Step 4 If .Cells(j - 2, 7).Value = "開発" And _ .Cells(j - 2, 10).Value = "作業中" And _ IsDate(.Cells(j, i)) = True Then Set f = tSh.UsedRange.Find(.Cells(j, i), , , xlWhole) If Not f Is Nothing Then Set s = tSh.UsedRange.Find(.Cells(j, i) + 7, , , xlWhole) If s Is Nothing Then Set s = tSh.Cells(Rows.Count, f.Column).End(xlUp).Offset(1) ' Application.Goto s, True ' Stop Else Set s = s.End(xlUp).Offset(1) ' Application.Goto s, True ' Stop End If s.Value = .Cells(j - 2, 8) & vbLf & .Cells(2, i) ' Stop End If Set f = Nothing Set s = Nothing End If Next Next End With Application.ScreenUpdating = True End Sub よろしくお願いいたします。 （s55tac） 2017/03/01(水) 22:30 ---- こんにちは 作業と会議室の組み合わせが1日あたり3件以上は無いという前提でいいですか? （ウッシ） 2017/03/02(木) 07:52 ---- ウッシ様 作業と会議室の組み合わせが1日あたり3件以上は無いという前提で構いません。 よろしくお願いいたします。 （s55tac） 2017/03/02(木) 08:54 ---- こんにちは 表示用カレンダーシートは作りがダメです。 一か月の表が5週しか無いですが、6週必要なのが普通では? 5週で運用するなら、例えば、2017/5のカレンダーの最後の土曜日は2017/6/3になるので、 次のカレンダーは、のスタートは日曜日2017/6/4でないと。 或いは、一つのカレンダーを月毎にするのなら6週表示にするかです。 決めの問題ですが、カレンダーの作成はどこかに開始年度を入力し3年度分は数式で 作るようにしてはどうですか? あとは、表示用カレンダーは横長すぎて使い辛くないですか? 表示用カレンダー_縦の方がウィンドウ枠固定してスクロールすれば 見やすいと思うのですが、どうですか? （ウッシ） 2017/03/02(木) 10:00 ---- ウッシ様 ご指摘ありがとうございます。 「表示用カレンダー_縦」の運用で進めることにします。 Sub test3() にてご教示いただいたもので、カレンダーを3年分にして試してみました。 無事に作業と会議室の組み合わせが1日あたり3件以上あった場合でも動きました。 ただ、「日程」シートの日にちを修正することを想定し、 「表示用カレンダー_縦」シートを開く毎に、カレンダーを 一度クリアして書き込むようにしたいのですが、うまく動きません。 恐れ入りますが、追加でご教示いただけませんでしょうか。 よろしくお願いいたします。 （s55tac） 2017/03/02(木) 11:35 ---- こんにちは 「表示用カレンダー」シートを開く毎に、「表示用カレンダー_縦」シートの カレンダーを一度クリアして書き込むようにしました。 「表示用カレンダー」シートは、「表示用カレンダー_縦」シートからひと月分の データを数式で参照して表示するようにすればいいと思います。 「表示用カレンダー」の初期年月日を、「日程」シートの日付の最小値にすれば カレンダーの日付とデータが更新されるといいかと思います。 '「表示用カレンダー」シートのイベントモジュール Private Sub Worksheet_Activate() Dim mSh As Worksheet Dim tSh As Worksheet Dim f As Range Dim s As Range Dim i As Long Dim j As Long Dim e As Long Dim r As Range Dim d As Date Set mSh = Worksheets("日程") Set tSh = Worksheets("表示用カレンダー_縦") d = #1/1/2999# With mSh e = .Range("K" & Rows.Count).End(xlUp).Row For i = 23 To 12 Step -1 For j = 5 To e Step 4 If .Cells(j - 2, 7).Value = "開発" And _ .Cells(j - 2, 10).Value = "作業中" And _ IsDate(.Cells(j, i)) = True Then If d > .Cells(j, i) Then d = .Cells(j, i) End If End If Next Next End With Me.Range("K1").Value = d Application.ScreenUpdating = False tSh.Unprotect For Each r In tSh.UsedRange If r.MergeCells = True Then If r.Value <> "" Then r.Value = "" End If End If Next With mSh e = .Range("K" & Rows.Count).End(xlUp).Row For i = 23 To 12 Step -1 For j = 5 To e Step 4 If .Cells(j - 2, 7).Value = "開発" And _ .Cells(j - 2, 10).Value = "作業中" And _ IsDate(.Cells(j, i)) = True Then Set f = tSh.UsedRange.Find(.Cells(j, i), , xlValues, xlWhole) If Not f Is Nothing Then Set s = f.Resize(10).Find("", f, , xlWhole) If s Is Nothing Then Set s = tSh.Cells(Rows.Count, f.Column).End(xlUp).Offset(1) Else Set s = s.End(xlUp).Offset(1) End If s.Value = .Cells(j - 2, 8) & vbLf & .Cells(2, i) End If Set f = Nothing Set s = Nothing End If Next Next End With tSh.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True Application.ScreenUpdating = True End Sub http://xfs.jp/jX1mBx にファイル、アップしておきました。 （ウッシ） 2017/03/02(木) 12:04 ---- ウッシ様 ファイルダウンロードしました。 ありがとうございます。 「表示用カレンダー」だと1か月単位でしか表示されないので、 「表示用カレンダー_縦」シートを開く毎に、「表示用カレンダー_縦」シートの カレンダーを一度クリアして書き込むように変えられませんでしょうか? よろしくお願いいたします。 （s55tac） 2017/03/02(木) 14:21 ---- こんにちは 表示用カレンダー_縦シートの日付は、表示用カレンダーシートの セルK1の日付を参照しているので、表示用カレンダーシートはそのまま にしておいて下さい。 Private Sub Worksheet_Activate() Dim mSh As Worksheet Dim tSh As Worksheet Dim f As Range Dim s As Range Dim i As Long Dim j As Long Dim e As Long Dim r As Range Set mSh = Worksheets("日程") Set tSh = Worksheets("表示用カレンダー_縦") Application.ScreenUpdating = False tSh.Unprotect For Each r In tSh.UsedRange If r.MergeCells = True Then If r.Value <> "" Then r.Value = "" End If End If Next With mSh e = .Range("K" & Rows.Count).End(xlUp).Row For i = 23 To 12 Step -1 For j = 5 To e Step 4 If .Cells(j - 2, 7).Value = "開発" And _ .Cells(j - 2, 10).Value = "作業中" And _ IsDate(.Cells(j, i)) = True Then Set f = tSh.UsedRange.Find(.Cells(j, i), , xlValues, xlWhole) If Not f Is Nothing Then Set s = f.Resize(10).Find("", f, , xlWhole) If s Is Nothing Then Set s = tSh.Cells(Rows.Count, f.Column).End(xlUp).Offset(1) Else Set s = s.End(xlUp).Offset(1) End If s.Value = .Cells(j - 2, 8) & vbLf & .Cells(2, i) End If Set f = Nothing Set s = Nothing End If Next Next End With tSh.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True Application.ScreenUpdating = True End Sub をセットすればいいです、 「表示用カレンダー」だと1か月単位でしか表示されない というのも、必要な月数表示するように修正するのもいいかも。 （ウッシ） 2017/03/02(木) 14:30 ---- ウッシ様 ご対応ありがとうございました。 無事にうごいてくれました。 理想通りのものが出来て感激です! ありがとうございました。 （s55tac） 2017/03/03(金) 09:30... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/201702/20170228130843.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 96993 documents and 607811 words.
訪問者：