[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『20人の月間シフトをsheet1に作成し、一日ごとに1日〜31日、31枚のsheetに分解します。 月間シフトデータを日ごとに分けたsheetとリンクさせます。日ごとのsheetはその日のデータをもとにシフト時間をグラフ表示しています。ですから、月間シフト作成すると日ごとの31枚sheetsはリンクで何もしなくても完成します。 』
-------------------------------------------------------------------------------- （hallow77club） 質問は、月間シフトで当番の日にセルの色を変えた時、リンクするsheetの値のセルの色も変えたいのです。リンク先が特定されてるので、何かうまい方法はないか、GOOD IDEAを期待します。さらに、当番者が日ごとsheet内で特定行に移動できたら、日ごとsheetでシフト確認が素晴らしくわかり易くなります。24時間のスタッフ入り状況がグラフでわかりやすくなります。よろしくお願いします。 WindowsXP Excel2007 もし、Excel2010なら可能なのか、あわせて教えて下さい。 このファイルは4ファイルあり、管理者は各月間シフトファイルを統合し時間ごとの全体チェックに利用の予定です。
少なくとも関数では無理だと思うね。 で、ＶＢＡでも、参照しているのが同じシートなら、簡単に処理できるけど、別シートの参照のようなので これは、かなりアクロバチックなコードになるような予感が。 たとえばエクセルの機能で、参照先のトレースや参照元のトレースを動かしても、別シートの参照の場合、どのセルかがわからないない。 だからエクセルにも無理なので。 （同じシートの場合は数式内の参照先や参照元のセルがどこなのか取得可能だけど別シートだとＭＳがいじわるをして？情報を隠している）
ところで、以下には、間違って？書き込みしたのかな？
[[20031215230053]] 『セル参照のとき文字列だけではなく文字色と背景色』（FELL）
(ぶらっと)
ところで、 ・月間シフトシートのレイアウトと、そのなかのどこの色を変えるのか教えてくれる？ ・「さらに、当番者が日ごとsheet内で特定行に移動できたら、」 これは、 どのシートで どんな操作を行ったときに 日ごとシートのどこに移動するの？（移動先は何をベースにして判定？）
いずれにしても、ＶＢＡでやるにしても、「色が変わったら」自動実行は無理だね。 (裏で、監視ロジックを走らせたり、通常は、我々には渡らない動きを、特殊な手法で、Windowsから、ぶんどれば（？）できないことはないけど）
色をかえたら、そのセルをダブルクリックとか、そういうことならできるけど。
(ぶらっと)
月間シフトsheetは横型カレンダーで31列のシフトデータと縦に20人スタッフがあります。
シフトデータ入力は単純に、31列*20人＝620セルあります。スタッフが部署移動してやりくりしてる為、移動当番者（2名/日）が誰なのか、シフトデータのセルの背景色変更してわかりやすくしてます。
しかし、日ごとsheet（月間シフトsheetとデザインは似てます。一日の20名分のシフト一覧。シフト時間を横軸 朝6時〜翌日8時 縦軸20名とシフト名表示）のシフトデータには参照してるけど、月間シフトでセルの色を変えても、日ごとsheetのセルの色までは参照出来ないのですね。
そこで、月間シフトsheetで色を変えたシフトデータセルをダブルクリックして、VBAが実行できれば、びっくりするほどの進歩です。ただし620セル分あるので、20名分VBA*31日sheet書くのは、結構な作業ですね。でも、挑戦したいので、是非とも教えて下さい。
日ごとシート内で移動するのは、勤務部署がその当番日に変更（2名/日）になるためです。日ごとシート内の特定の行に移動し、グラフ表示されれば素晴らしいと思ったのですが、私には無理そうなので取消します。ごめんなさい。 どうぞよろしくお願いします。
hallow77club@ae.auone-net.jp
おおよそのイメージは了解。 コードを必要最小限にするために以下、質問と確認。
１．まず、月間シフトシート。
A2から下に20名（何名でもいいけど）名前、B1から横に、AF1まで日付
こんなレイアウトでいい？
2.日ごとシート
1)シート名のルールはある？ たとえば、4日なら"4" とか "4日"とか。
2)レイアウトとしては、A列は、月間シフトシートと、全く同じ？ それとも、並び順が違うとか、月間シフトシートには
登場しない名前があるとか？
3)それと、『シフト名』というのが気になる。シフト名は、どこに記載されていて、それは、どんな意味を持っているの？
（意味というのは、日本語としての意味ではなく、それが "AAA" なら、それは、処理のロジックにどう関係するのかしないのか？）
4)横軸は、B1から横に時間帯？
5)このシートのそれぞれのセルに、具体的にどんな式が入っているの？（特に重要）
これらの回答の内容次第で、まちゃめちゃ簡単なロジックになるかもしれないし、上でコメントした、関数分析ロジックを 盛り込む必要があるかもしれない。
(ぶらっと)
とりあえず、月間シフトシートについて、しつこく、追加質問
月間シフトシートの日付タイトル行は、「日付型」つまり、値としては yyyy/m/d で 表示書式で 16日 等にしているということだね。 で、31日の列（Q列かな？）の対応はいいけど、２月、さらに、それがうるう年といったものを考えると、この式は、もう少し考えたほうが いいかもしれないけど、ロジックには関係ないので、横に置いておき、31日がない場合、値としては【空白】ということだね？
で、データの合間、合間の行に、見やすくするために日付タイトル行があるのはいいけど、その日付タイトル行はA列が【空白】として判断していいね？
それと、式の中の、$A$3 や $C$3 や $D$4:$AH$4 って？？ こちらの理解では、３行目も４行目も「誰かの」データ行と思っているんだけど？
追記）そのあとの、日ごとシートの説明を読んでいるうちに、ますます、わからなくなった。 「ほぼ同様」とか、「不要なカレンダー」とか、「月間シフトシートの端に」ということだと 実際に、どの行のどの列に何がある、何が削除されているということが、わからない。 ２つのシートのシートレイアウトを具体的なイメージにしてアップしてくれないかな？
(ぶらっと)
>文章で説明は誠に難しいですネ。
うん。難しいね。なので、皆さん、たとえば [[20120731144914]] 『変更前・変更後のデータを別シートへ』（UMI） 実は、↑もレイアウトの理解に時間がかかったけど、それでも、まず、最初に質問者さんが レイアウトを、『イメージ』としてアップしてくれている。 このような形で、具体的に教えてもらえれば理解しやすいんだけどね。
それと、
１．まず、月間シフトシート。
A2から下に20名（何名でもいいけど）名前、B1から横に、AF1まで日付
こんなレイアウトでいい？
このように確認していることに対して、そちらからは、『1.その通りです』 でも、今回、『$A$3は年号セル、$C$3は月、$D$4:$AH$4は16日から15日。$D$5:$AH5には対応する曜日表示にしました。 』
あれ？2行目より下は（間に挟み込んである1行目と同じフォーマットの日付タイトル以外は）個人データ行のはずなのに？
解決の手段が関数であれマクロであれ、レイアウトがきっちりわからないと、回答ができない。
『全体の形としては左縦列に名前、横行は日付と日に対応する値ということで、まちがいありません』 じゃなく A列がこうとか、B列がこうとか、2行目がこうとか。
『同じシートのどこかに書かないといけないため、シート右下の見えないところに書きました』
もし、このセルを、処理上、相手にしなくてもいいのだったらいいんだけど、相手にするなら たとえば AB60 のセル といったように明記して欲しいわけ。
(ぶらっと)
追記で
日ごとシート について
1)シート名のルールはある？ たとえば、4日なら"4" とか "4日"とか。
2)レイアウトとしては、A列は、月間シフトシートと、全く同じ？ それとも、並び順が違うとか、月間シフトシートには
登場しない名前があるとか？
3)それと、『シフト名』というのが気になる。シフト名は、どこに記載されていて、それは、どんな意味を持っているの？
（意味というのは、日本語としての意味ではなく、それが "AAA" なら、それは、処理のロジックにどう関係するのかしないのか？）
4)横軸は、B1から横に時間帯？
5)このシートのそれぞれのセルに、具体的にどんな式が入っているの？（特に重要）
この５つの質問をしているんだけど、すべてに回答をしてほしいな。
(ぶらっと)
A列 B列 C列 D列 E列 F列 G列
1
2
3
4
5 =月間シフト!D4 ←C5。（月間シフトd4は=DATE($A$3,$C$3,16)書式設定は d"日"。)
6
7
8 =IF(月間シフト!A6=0,"",月間シフト!A6)←A8部署。
8 =IF(月間シフト!B6=0,"",月間シフト!B6)←B8社員コード(但し、Ｂ列は非表示)
8 =IF(月間シフト!C6="","",月間シフト!C6)←C8スタッフ名。
8 =IF(月間シフト!D6="","",月間シフト!D6)←D8シフト名(【シフト名】は文字列。
8 E8は空欄(E列は空欄)
8 F8は勤務表の出勤時刻。月間シフトの$EU$295:$EZ$346をVLOOKUP参照。
8 G8は中抜始時刻。参照先はF8と同じ。
8 H8は中抜終時刻。参照先はF8と同じ。
8 I8は退社時刻。参照先はF8と同じ。
--------------------------更に右隣セルに続きます。グラフ表示用の値計算です。
8 J列 K列 L列 M列
8 =F8 ←出勤時刻
8 =IFERROR(IF(G8-F8<0,1+G8-F8,G8-F8),"") ←当日1回目の勤務時間
8 =IFERROR(IF(H8-G8<0,1+H8-G8,H8-G8),"") ←中抜した時間
8 =IFERROR(IF(I8-H8<0,1+I8-H8,I8-H8),"")←当日2回目の勤務時間
.
.
14 この行まで上の式と同じ。勿論、月間シフトsheetの参照セルは順にずれていきます。
15 A$15 15行目は空欄
16 A列 B列 C列
16 =IF(月間シフト!A16="","",月間シフト!A16) ←A16。部署。
以下、上記同様に続きます。
22 この行まで使います。よって、上段7名、下段7名 このようなレイアウトです。
↑の追加説明は、今から一生懸命読んで理解につとめてみる。 ところで、こちらから提案するのはVBAコードだけど、それでいいのかな？
で、もう作成済みの各シートなので、それはそれでいいんだけど、各シートに関数式を埋め込むのは 大変だっただろうなと推測。どうせVBAでやるなら、各シートで関数処理をしているところも、 VBAで肩代わりできるところも多いんだと思う。思うけど、そうするには要件がクリアにならなければできないし クリアにするためには、またまた質疑応答が延々と続きそうだから、それはやめようね。
とにかく、今、わかったことは日ごとシートのデータ行が８行目からはじまっているらしいということ。 でも、ちらっと目に入った説明の中に、「上段7名、下段7名」、最初の質問文の中に「20人の月間シフト」 ７名＋７名＝１４名と２０名？ まぁ、このあたりも、↑の説明を熟読すればわかるのかな？
いずれにしても、じゃぁ、将来、３０名のスタッフになったらどうするんだろうとか、モヤモヤしたところはあるけど。
(ぶらっと)
かなり理解が進んでいる。 『F8は勤務表の出勤時刻。月間シフトの$EU$295:$EZ$346をVLOOKUP参照。』
１つだけでいいので、F8の式をアップしてくれる？
追加で）ずっと最初のほうで、月間シフトシートのどこの色を変えるのか質問していたと思うけど、 これを、具体的に教えてくれる？ で、そのとき、日ごとシートのどこに、その色を反映させるかも。
(ぶらっと)
直前のスレで質問している２つの点については回答をお願い。
で、いずれにしても、現在のシートの構成でＶＢＡ対応を考えるので、 『無理矢理』かつ『中途半端』な処理にならざるを得ないと思う。
最初に、『何かうまい方法はないか、GOOD IDEAを期待します』というコメントがあったね。 もし、最初からＶＢＡをかませるなら、自分なら徹底的にＶＢＡ処理をする。 現在の仕掛けは、関数処理なので、月間シフトシートの値を、日ごとセルに参照式をいれて 取り出す仕掛け。あたりまえだけど。
つまり、入力しているのは、月間シフトシートなのに、それが『主役』にはならず、 日ごとシートが『主役』。主役であるべき、入力をしている月間シートからみたとき その入力値が、どのシートのどのセルに反映するか、全くわからないわけだよね。
それなのに、今回、色が塗られたセルに対して、そのセルが、どこに反映しているのか わからないので、めくらめっぽう（？）日ごとシートをさがしまわらなければいけない。
最初から、この要件であれば、自分なら
・日ごとシートには、月間シフトシートを参照する関数式を書かない。 ・月間シフトシート側で、転記必要セルに、入力があったら、自動的に、『転記すべき日ごとシートのセル』に 自動転記する。 ・ということは、月間シフトシート側からみて、どのセルがどのシートのどの場所に紐つくかの制御を持つということなので 月間シフトシート上の色塗りセルの色も、それに紐つく日ごとシートに無理なく反映させることができる。
こういう構えにするね。
(ぶらっと)
■F8の式は =IFERROR(IF(VLOOKUP(D8,月間シフト!$EU$295:$EY$346,2,FALSE)=0,"",VLOOKUP(D8,月間シフト!$EU$295:$EY$346,2,FALSE)),"")
■月間シフトの16日〜15日のシフト名を入力した内の当番日のセル。つまり、スタッフ数×31列の内の当番日（当番日はランダム)の背景色を変更したとき、紐つく日ごとシートのシフト名セルに自動的に同じ色の背景色にしたいのです。当番日の背景色は統一。
例えば、月間シフトのＢ君25日が当番なら、該当セルをactiveにしてからセルに背景色をつけます。すると、紐つく"25日"シートのＢ君のシフト名のセルにも同一の背景色がつく。このようにしたいのです。
ご提案戴いた方向で、進めたいです。
『月間シフトシート上の色塗りセルの色も、それに紐つく日ごとシートに無理なく反映・・』
この1行にくぎ付けになりました。よろしくお願いします。
hallow77club
それでは、まず、今のまま、日ごとシートには関数があって、値の反映は関数で行うという 構成のまま、『レイアウトの定義』だけは、ＶＢＡ側が握って色を反映させるという部分だけを。
前提としているレイアウトは、コードの上のほうの、Public Const で規定。 また、日付タイトルは『表示書式』で、16日とか17日と表示されており、日ごとシート名はそれらと同じ。 データ開始行は異なっていても、月間シフトシートと日ごとシートのデータ（個人毎のデータ）の順番は それぞれ、全く同じものとする。
処理としては、日ごとシートに反映させたい月間シフトシートの日付のセル（複数ＯＫ）を選び、マクロを実行。 セルの選択は、『几帳面に』日付セル（群）だけを選んでもいいし、その列（群）を選んでもいい。 選ばれたセル（群）のなかから日付セルのみをピックアップして処理を行っている。
これで、目的達成なら、それはそれでハッピーなので解決かな。
提言したような、月間シート側入力を、日ごとシートに、自動転記（つまり日ごとシートには関数を持たない） 処理も、こちらでは７０％ほど完成している。 もし、この先、全体の構成をその方式に切り替えたいのなら、今回アップするコードがＯＫになった後、 また、お手伝いしてもいい。
標準モジュールに。
Option Explicit '月間シフトシートの規定 Public Const MshN As String = "月間シフト" 'シート名 Public Const MdLine As Long = 4 '日付タイトル行番号 Public Const MstLine As Long = 6 'データ開始行番号 Public Const MstCol As Long = 4 'シフト開始列番号(D列) '日ごとシートの規定 Public Const DstLine As Long = 8 'データ開始行番号 Public Const DstCol As Long = 4 'シフト列番号(D列)
Sub 色コピー()
Dim sh As Worksheet
Dim r As Range
Dim c As Range
Dim shn As Variant
Dim x As Long
Dim z As Long
Dim i As Long
If Not ActiveSheet Is Sheets(MshN) Then
MsgBox MshN & " をアクティブにして実行してください"
Exit Sub
End If
Set r = Intersect(Selection, Range(Cells(MdLine, MstCol), Cells(MdLine, MstCol + 30)))
If r Is Nothing Then
MsgBox "シフト色をコピーする日付（複数ＯＫ）が選ばれていません"
Exit Sub
End If
z = Range("A" & Rows.Count).End(xlUp).Row '月間シフトシートのデータ最終行
For Each c In r
shn = Cells(MdLine, c.Column).Text
If Not IsObject(Evaluate("'" & shn & "'!A1")) Then
MsgBox shn & " シートがないのでスキップします"
Else
x = DstLine
For i = MstLine To z
With Sheets(shn).Cells(x, DstCol).Interior
.ColorIndex = xlNone
If Cells(i, c.Column).Interior.ColorIndex <> xlNone Then .Color = Cells(i, c.Column).Interior.Color
x = x + 1
End With
Next
End If
Next
End Sub
(ぶらっと)
(ぶらっと)さん、ビックリ、仰天、ウェー!ヴヒョウー!感激が止まりません!! 標準モジュールにご回答を複写し、コンパイルＯＫなので、ウォ?ホントかな(失礼)と思い、 月間シフトのカレンダー16日をクリックし、いざ［色コピー］マクロ実行したら、一発ＯＫ。 カレンダーの17日〜20日を範囲選択して［色コピー］マクロ実行し、疑いながら（失礼）日ごとシートのそれぞれを開いてもＯＫ。 カレンダーの31日間全部範囲選択してもＯＫ!!!!!! スゴイです。動作も実に早いです。感謝感激。なんか、魔法みたいです。 ほとんどあきらめかけてたことですが、懇切丁寧にご指導戴きまして本当に有り難うございます。 今は教えていただきましたＶＢＡ構文を何度も読んで、すこしでも理解しようとしています。 また、更なる研究をしてくださっているとのこと。 もし実現したら、私にとってはExcel革命です。ご期待申し上げます。 (hallow77club) 59才♂
今回のコードがうまくいったと言うことは、こちらで把握しているレイアウトが 的外れではなかったということなので、書きかけの、その他の提言している方式も書き上がれば アップ予定。こちらのほうは少し時間がかかるかもしれないけど。
ところで、アップしたコードだけど、
標準モジュールには Option Explicit から Public Const DstCol As Long = 4 'シフト列番号(D列) だけを残し、Sub 色コピー() 以下を削除。
で、月間シフトシートのシートタブを右クリックしてコードの表示を選ぶとでてくる シートモジュールという場所に、以下を貼り付けると、マクロ実行しなくても、 カレンダーの必要な日付を選択するだけで、色コピーが自動で行われる。 もし、そのほうが、運用面でやりやすければ、どうぞ。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim sh As Worksheet
Dim r As Range
Dim c As Range
Dim shn As Variant
Dim x As Long
Dim z As Long
Dim i As Long
Set r = Intersect(Target, Range(Cells(MdLine, MstCol), Cells(MdLine, MstCol + 30)))
If r Is Nothing Then Exit Sub
z = Range("A" & Rows.Count).End(xlUp).Row '月間シフトシートのデータ最終行
For Each c In r
shn = Cells(MdLine, c.Column).Text
If Not IsObject(Evaluate("'" & shn & "'!A1")) Then
MsgBox shn & " シートがないのでスキップします"
Else
x = DstLine
For i = MstLine To z
With Sheets(shn).Cells(x, DstCol).Interior
.ColorIndex = xlNone
If Cells(i, c.Column).Interior.ColorIndex <> xlNone Then .Color = Cells(i, c.Column).Interior.Color
x = x + 1
End With
Next
End If
Next
End Sub
(ぶらっと@ちなみに62才)
普段Excel使っている人でも、ファイルの使い方説明しただけでは、この機能はExcelの機能と思って、“自分のパソコンは調子が悪いらしい”という頓珍漢な相談になってしまうかも!
私自身、Excel VBA の新たな世界に入り込んだようです。
嬉しくて、たまりません。 本当に感謝申し上げます。
今晩の予定は、戴きましたコード理解のため 少しづつですが取っ組みたいと思います。
ファイルを使って頂ける人に解説が出来るようになるには、まだまだ遠いです。
hallow77club
現在は、関数処理と、私がアップしたシフト色付けマクロの組み合わせて 【機嫌よく？】運用されていると思うので、それでおしまいということでも、なんら構わないと 思うので、以下は、あくまで【参考】。
現行のブックを別名でコピーして、そのマクロを以下にアップするもので入れ替えて、時間があれば 試してみて。
少し前触れで。
(月間シフトシート) ・A列〜AH列の動きだけをサポート。その右にあると思われるグラフ用領域には何もしていない。 ・D列〜AH列の6行目以降、適宜、日付タイトル行があり、おそらくは、4行目を参照していると思われるけど 以下では、とりあえず【無視】、6行目以降は、すべて、個人関連情報と、そこに設定されたシフト名のみという 扱い。（これについては、最後に、なんとでも対応可能） ・D4〜AH4 も含めて、A列〜AH列には関数式は一切、入っていないという前提。（必要な日付等はマクロで自動生成） ・A3 と C3 に値が入れば、D列〜AH列の、当該月に存在しない日の列は空白にしている。（非表示にもできるけど） ・また、同時に、日ごとシートで、当該月にない日付のシートは、F列〜I列を空白にしたうえで、非表示。 ・A列〜C列の個人関連情報に変更があれば、自動的に、すべての日ごとシートの当該場所も変更。 ・D列〜AH列のシフト名に変更があれば、当該日ごとシートの当該シフト名も自動変更し、その行の４つ時刻も テーブルからピックアップしてセット。 ただし、F列についてはテーブルの２列目ということは説明もらったけど、G列〜I列については説明がないので とりあえず、テーブルの３列目、４列目、５列目 としている。
(日ごとシート) ・上でもふれたけど、【1日〜31日】の、すべてのシートがあらかじめ存在するという前提。 ・これについても月間シフトシートと同じく、A列〜I列まで、関数式は入っていないという前提。 月間シフトシート側の変更で、自動連動でセットされる。 ・また、おなじく、8行目以降は、すべて個人関連情報と、当該日のシフト名だけという前提。 おそらくは、適宜空白行があると思われるけど、コードでは、そこも個人データ行と認識。 ・【重要】月間シフトシートは6行目から、日ごとシートは8行目からデータだけど、この並びと場所は 一致しているという前提。つまり、月間シフトデータの 10 行目は、日ごとシートの12 行目にあたるという 処理を行っている。このあたりは、最後に、いかようにでも対応可能。
ということで、実際のレイアウトとは若干異なると思うけど、とにかく、月間シフトシート上で、いろいろ 項目を入れたり消したりして試してみて。
で、コード。
１．前回、最終的な構成が未確定だったので、とりあえず標準モジュールに Public Const 群を記述したけど 結局、シートモジュールのみのコードになったので、これを消すか、あるいは、標準モジュールそのものを 解放して削除しておいてね。 ２．シートモジュールがわ、前回アップしたコードも含めて、以下でそう取り替え。
Option Explicit
'月間シフトシートの規定 Const MshN As String = "月間シフト" 'シート名 Const MdLine As Long = 4 '日付タイトル行番号 Const MstLine As Long = 6 'データ開始行番号 Const Myy As String = "A3" '年入力セル Const Mmm As String = "C3" '月入力セル Const MstCol As Long = 4 'シフト開始列番号(D列) '日ごとシートの規定 Const DstLine As Long = 8 'データ開始行番号 Const DstCol As Long = 4 'シフト列番号(D列) Const TimeCol As Long = 6 '４つの時刻開始列(F列)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r1 As Range
Dim r2 As Range
Dim r3 As Range
Dim a1 As Range
Dim a2 As Range
Dim a3 As Range
Dim flag As Boolean
Dim z As Long
If Target.Areas(1).Rows.Count = Rows.Count Then
CancelChange "このシートでは列の挿入・削除はできません"
Exit Sub
End If
If Target.Areas(1).Columns.Count = Columns.Count Then flag = True '行挿入
z = Range("A" & Rows.Count).End(xlUp).Row 'データ最終行
Set a1 = Union(Range(Myy), Range(Mmm)) '年、月 入力領域
Set a2 = Range("A" & MstLine).Resize(z - MstLine + 1, 3) '部署、社員コード、氏名領域
Set a3 = Cells(MstLine, MstCol).Resize(z - MstLine + 1, 31) 'シフト名領域
Set r1 = Intersect(Target, a1)
Set r2 = Intersect(Target, a2)
Set r3 = Intersect(Target, a3)
If r1 Is Nothing And r2 Is Nothing And r3 Is Nothing Then Exit Sub '対象領域以外の変更
If Not r1 Is Nothing And (Not r2 Is Nothing Or Not r3 Is Nothing) Then
CancelChange "（年、月） 欄への入力とその他入力を同時に行うことはできません"
Exit Sub
End If
Application.EnableEvents = False
If Not r1 Is Nothing Then
If Not DateSet Then Exit Sub
flag = True
End If
If flag Then Call DailyShMaking(a1, a2, a3)
If Not r2 Is Nothing Then Call ItemSet(r2)
If Not r3 Is Nothing Then Call ShiftSet(r3)
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim sh As Worksheet
Dim r As Range
Dim c As Range
Dim shn As Variant
Dim x As Long
Dim z As Long
Dim i As Long
Set r = Intersect(Target, Range(Cells(MdLine, MstCol), Cells(MdLine, MstCol + 30)))
If r Is Nothing Then Exit Sub
z = Range("A" & Rows.Count).End(xlUp).Row '月間シフトシートのデータ最終行
For Each c In r
shn = Day(Cells(MdLine, c.Column).Value) & "日"
x = DstLine
For i = MstLine To z
With Sheets(shn).Cells(x, DstCol).Interior
.ColorIndex = xlNone
If Cells(i, c.Column).Interior.ColorIndex <> xlNone Then .Color = Cells(i, c.Column).Interior.Color
x = x + 1
End With
Next
Next
End Sub
Private Function IsSheet(shn As Variant) As Boolean
IsSheet = IsObject(Evaluate("'" & shn & "'!A1"))
End Function
Private Sub CancelChange(msg As String)
Dim sv As Boolean
sv = Application.EnableEvents
Application.EnableEvents = False
MsgBox msg & vbLf & "入力を取り消し、元に戻します"
Application.Undo
Application.EnableEvents = sv
End Sub
'
Private Function DateSet() As Boolean
Dim yy As Long
Dim mm As Long
Cells(MdLine, MstCol).Resize(, 31).ClearContents
If IsEmpty(Range(Myy)) Or IsEmpty(Range(Mmm)) Then Exit Function
yy = Val(Range(Myy).Value)
mm = Val(Range(Mmm).Value)
Cells(MdLine, MstCol).Value = DateSerial(yy, mm, 16)
Cells(MdLine, MstCol).Resize(, Day(DateSerial(yy, mm + 1, 0)) - 15).DataSeries
Cells(MdLine, MstCol).Offset(, 16).Value = DateSerial(yy, mm + 1, 1)
Cells(MdLine, MstCol).Offset(, 16).Resize(, 15).DataSeries
DateSet = True
End Function
Private Sub DailyShMaking(r1 As Range, r2 As Range, r3 As Range)
Dim todd As Long
Dim i As Long
Dim shn As Variant
Dim yy As Long
Dim mm As Long
Dim nosData As Long
Dim x As Long
Dim z As Long
Dim c As Range
Dim v As Variant
yy = Range(Myy).Value
mm = Range(Mmm).Value
todd = Day(DateSerial(yy, mm + 1, 0))
For i = 1 To 31
shn = i & "日"
If i < 16 Then
x = i + 16
Else
x = i - 15
End If
With Sheets(shn)
z = .Range("A" & .Rows.Count).End(xlUp).Row
If z >= DstLine Then
.Range("A" & DstLine & ":S" & z).Resize(, 9).ClearContents
End If
If r2.Rows.Count > 0 Then _
.Range("A" & DstLine).Resize(r2.Rows.Count, r2.Columns.Count).Value = r2.Value
r3.Columns(x).Copy .Cells(DstLine, DstCol)
If i > todd Then
Sheets(shn).Visible = False
Else
Sheets(shn).Visible = True
For Each c In .Cells(DstLine, DstCol).Resize(r3.Rows.Count)
Call ShiftLookUp(c)
Next
End If
End With
Next
End Sub
Private Sub ItemSet(r As Range)
Dim c As Range
Dim i As Long
For Each c In r
For i = 1 To 31
Sheets(i & "日").Cells(c.Row + DstLine - MstLine, c.Column).Value = c.Value
Next
Next
End Sub
Private Sub ShiftSet(r As Range)
Dim c As Range
Dim i As Long
Dim v As Variant
For Each c In r
i = Day(c.EntireColumn.Cells(MdLine).Value)
With Sheets(i & "日").Cells(c.Row + DstLine - MstLine, DstCol)
.Value = c.Value
Call ShiftLookUp(.Cells(1))
End With
Next
End Sub
Private Sub ShiftLookUp(c As Range)
Dim w As Variant
Dim tbl As Range
Set tbl = Sheets(MshN).Range("EU295:EY346")
w = Application.Match(c.Value, tbl.Columns(1), 0)
If IsNumeric(w) Then
c.EntireRow.Cells(1, TimeCol).Resize(, 4).Value = _
Array(tbl(w, 2).Value, tbl(w, 3).Value, tbl(w, 4).Value, tbl(w, 5).Value)
Else
c.Offset(, 1).Resize(, 4).ClearContents
End If
End Sub
(ぶらっと)
(ぶらっと)さん。今晩は。 先日戴きました、色コピーVBAは大変快適です。標準モジュール分はクイックアクセスツールバー登録。シートモジュールにも記入。現在は入力リセットにも組込み快適に動作してます。 現在、全体のシフト一覧に追加や変更がありますが、落着いた段階でテンプレートファイルにしたいと考えてました。 ・・・が、しかし、 ものすごい!? 大作コード。 正直、理解できないのですが、なんとなくすごい予感がします。 現在進行中の4部署8月、9月予定入力とテストが終わり次第とりかかります。 まずは、そっくりコピーして【大改造・月間シフト】フォルダにキープしたいと思います。
別件で質問です。
日ごとシート31枚をグループ化し、印刷プレビュー表示までのマクロは15秒前後かかります。
この、印刷プレビュー表示までのメモリー?読込み状況はプログレスバー表示可能でしょうか?
Webで参考探したら、"印刷プレビューのプログレスバーはExcel VBAでは出来ない"という記事を数回見ました。そうなのでしょうか? 教えて下さい。
hallow77club
>日ごとシート31枚をグループ化し、印刷プレビュー表示までのマクロは15秒前後かかります。 >この、印刷プレビュー表示までのメモリー?読込み状況はプログレスバー表示可能でしょうか?
このあたりは（というより、エクセル全般に）うといので、適格なアドバイスができない。 申し訳なし。この学校には、エクセルの達人がそろっているので、別の、単独トピとして 本件の質問をアップすれば、たちどころに回答があると思うよ。
で、アップしたコードは、おちついたら、本当に参考として動かしてみるぐらいのノリで。 意図したのは
・少なくとも本件で見えている範囲（右のほうのグラフや分析用の部分は別にして）は 月間シフトシートもひごとシートも「関数レス」のシートにすることで、軽量化を図り また、担当の増減等での各シートのメンテを不要にしようとする。
それと、これはＶＢＡとか関数というものとは離れて、もしかしたらシート構成を
・月間シフトシートは、現在のＡＨ列までのシートにして、その右側のグラフ・分析は 別シートにしたら管理しやすいんじゃないか とか、 ・月間シフトシートの上にあると思われる各種マスタは、別途、マスタシートを作り、そこに移動。 いくつのマスタがあるのか、わからないけど、それぞれぞれに名前を付けておけば、 その内容に増減があっても、各シートで関数で参照するにせよ、ＶＢＡで参照するにせよ 変更は一切いらなくなるので、今後の運用上、楽なんじゃないか とか ・さらに、そのマスタを、2007以降で言えばテーブル、2003ならリスト というものにしておけば メンテナンスが、より一層、楽になるんじゃないか とか
そういったことを、ぼんやりと思っている。
(ぶらっと)
↑ あぁ、プレビューの時間というより、そこにいたるまでが長いのでプログレスバーを表示したいということだった？
でも、３１枚のシートのグループ化をプレビュー表示に１５秒は、いかにも、かかりすぎだねぇ。 そこのところのコードをアップしてもらえないかな。 もしかしたら、コードを改善することで、時間短縮でき、プログレスバーの必要がなくなるかも なので。
(ぶらっと)
たとえば 1日〜31日までのすべてのシートをPreView対象にするなら特にグループ化は必要なく 以下のようなコードで一瞬で出てくると思うんだけど？
Sub Test()
Dim v(1 To 31)
Dim i As Long
For i = 1 To 31
v(i) = i & "日"
Next
Sheets(v).PrintPreview
End Sub
(ぶらっと)
↑ は、ちょっと手抜きのコード。非表示の（あるいは存在しない）シートを対象外にしなきゃいけないけど それも、たいしてことはなく、いずれにしてもプレビューに時間がかかっているというところが変だね。
追記） 手抜きをしないプレビューコード
Sub TestX()
Dim v()
Dim i As Long
Dim d As Long
With Sheets("月間シフト")
d = Day(DateSerial(.Range("A3").Value, .Range("C3").Value + 1, 0))
End With
ReDim v(1 To d)
For i = 1 To d
v(i) = i & "日"
Next
Sheets(v).PrintPreview
End Sub
(ぶらっと)
Sheets(Array("16日", "17日", "18日", "19日", "20日", "21日", "22日", "23日", "24日", "25日", "26日", _
"27日", "28日", "29日", "30日", "31日", "1日", "2日", "3日", "4日", "5日", "6日", "7日", "8日", _
"9日", "10日", "11日", "12日", "13日", "14日", "15日")).Select
ActiveWindow.SelectedSheets.PrintPreview
Sheets("月間シフト").Select
Range("A1").Select
End Sub
ぶらっとさんのコード、早速、連続繰返し試してみましたところ、約13秒ぐらいでした。
ＣＰＵの能力不足でしょうか? 各sheetにグラフがついているからしょうがないのでしょう。
ありがとうございます。 ぶらっとさんのコードに変更します。
このマクロは、シフトのダブりや空白時間チェック、時間調整でかなり使います。
ということは、早く、ぶらっとさんのデザインに大改造というか作り直ししなくてはいけない見たいですね。改めて感謝。がんばります。
hallow77club
そちらのコードにしろ、こちらがアップしたサンプルにしろ、３１枚のシートのプレビューで１３秒〜１５秒というのは やはり、いかにもかかりすぎ。
上で書いた通り、当方、エクセルは、スタッフが作ってくれたものを見るだけの人で、自分自身の利用としては せいぜい並び替え、関数も =SUM 程度、ましてやグラフなんてのは、まず、幼稚園レベルなので、まったく詳しくなく、 このテーマで別途、新規質問トピをアップするのがいいと思う。
たとえば、今、こちらで、Ａ，Ｂ列に適当な文字列を１００行ほどつくって、Ｃ列〜ＢＺ列に重めの関数ということで 適当な SUMPRODUCT を１００行書いて、シートを重くしたうえで保存すると、もう、たいへん。 トイレにいって、ロビーでコーヒーを飲んで、席に戻っても、まだ保存が完了していなかった。
なので、もちろん、プレビューすべき１枚１枚のシートの領域が広いので負荷がかかっているということも考えられるけど 膨大な数の式やグラフというものがあった時に、プレビューにも悪さをしているのかも？ 上で提言したように、 ・できるだけ関数をなくしてＶＢＡ処理にかえる。 ・シートの用途を切り分けて、月間シフトシートや日ごとシートはスケジュール管理だけの部分にして ・その分析のための表やグラフは、別シート、できるなら、これを別ブックにしておくと それぞれの用途に絞った運用・処理が軽くなるのでは？ と思う。
また、プレビューの負荷については、ぜひ別トピにして専門家のアドバイスを求めてほしいけど だめもとで
処理の最初に
Application.Calculation = xlManual
処理の最後に
Application.Calculation = xlAutomatic
これを追加して実行するとどうだろうか？
(ぶらっと)
Application.Calculation = xlManual 〜 xlAutomatic の追記すると気持ち1秒ほど早くなりますね。不思議です。ありがとうございます。
プレビュー待機時間の件はこの辺までにして、本題に取り掛かりたいと思います。
hallow77club
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.