[[20170525155131]] 『重複セルに色をつける方法(条件付き書式・マクロ』(ぺんた) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『重複セルに色をつける方法(条件付き書式・マクロ・VBA)』(ぺんた)

お世話になります。
以前Yahoo知恵袋で質問しましたが、有効な回答が得られなかった為こちらで質問させて頂きます。

次のようなシフト表をExcel2013で作成しています。
○シート1日〜31日のB2には日付データを入力し、B3にはweekday関数で曜日を表示する
○B10・B15・B20・B25・B30・B35・B40には、曜日に対応するシートのデータがindirect関数で表示されるようにしてあります
(同様にC列〜Q列までindirect関数が入っています)
○シートmはシフトコードマスタになっており、B5にシフトコードを入力するとB6〜B8にシートmのデータをvlookup関数で表示する
○B10にシフトコードを入力すると、B11〜B14にシートmのデータをvlookup関数で表示する(同様に、B15・B20・B25・B30・B35・B40にコードを入力するとそれぞれのデータがB16〜B19・B21〜B24…に表示され、B列と同様の処理をC列〜Q列まで行っています)

以上を踏まえ、以下の条件でセルに色をつけたいと思っています。

1.シート1日〜31日の土曜日はB3を青、日曜と祝日はB3を赤にする
2.シート1日〜31日の土日祝日はH5〜Q44を赤にする
3.シート1日〜31日の土日祝日でも5行目のコードが808(希望休)以外であれば、その列は赤くしない
3.シート1日〜31日のB10〜G40内に重複するシフトコードが入っている場合は、重複するコードが表示されたセルを黄色にする(但し、indirect関数により空欄になっているセルは重複データとみなさず色は変更しない
4.3で色がついたセルについて、重複が解消された場合は色をつけない

サンプルファイルを次のURLにアップロードしました。
http://xfs.jp/CFMWx
パスワード:penta

条件付き書式でもマクロでもVBAでも構いませんので、どなたかご教示頂きますようお願い致します。

< 使用 Excel:Excel2013、使用 OS:Windows10 >


 ファイルは見ていないですが、どこがそんなに難しいのですか?

 条件付き書式で十分対応できるんじゃないですか?

 Countifで、自分と同じシフトコードを数えれば、
 2個以上で重複ですから直ぐ分かると思うのですが?

(半平太) 2017/05/25(木) 23:33


幾つかお尋ねです。
(すみません。会社でサンプルファイルがブロックされて見られないので、見れば分かることも伺います。)

1.土日は良いとして、祝日のデータをどこから入れるのでしょうか?
2.要件3の希望休はコード808をどこの5行目に入れるのでしょうか? B5?それともH5〜Q5?それともB5〜G5?
3.シフトの重複は、シート内のB10〜G40に限る?
(パオ〜〜ン) 2017/05/26(金) 10:23


>半平太さん
説明が難しいのですが、B10に入れたコードがB列にあるとは限らず、I35と重複している場合があります。

>パオ〜〜ンさま
説明が不十分で申し訳ありません。

>>1.土日は良いとして、祝日のデータをどこから入れるのでしょうか?

祝日のデータは祝日シートに列挙しております。

>>2.要件3の希望休はコード808をどこの5行目に入れるのでしょうか? B5?それともH5〜Q5?それともB5〜G5?

B5〜Q5に入れるよう想定しています。

>>3.シフトの重複は、シート内のB10〜G40に限る?

シフトの重複は、コードを入力する行(B10〜Q10、B15〜Q15、B20〜Q20、B25〜Q25、B30〜Q30、B35〜Q35、B40〜Q40)全てで起こりえます。
(ぺんた) 2017/05/26(金) 17:01


参考になるか分かりませんが、スクリーンショットを↓にアップロードしました。


(ぺんた) 2017/05/26(金) 17:17


手作業でセルに色をつけただけの仕上がりイメージですが↓にアップロードしました。


(ぺんた) 2017/05/26(金) 17:37


 >3.シート1日〜31日のB10〜G40内に重複するシフトコードが入っている場合は、
                            ↑
              Q40の間違いですか?

 間違いだとすると、上記「3〜4」の条件付き書式は
 「B10:Q44」をドラッグ選択して、条件数式を以下として設定する。

 =COUNTIF($B$10:$Q$40,(INDEX($A1:$Q44,INT(ROW()/5)*5,COLUMN())&"")*1)>=2

(半平太) 2017/05/26(金) 19:59


>半平太さん

回答ありがとうございます。
↑の条件付き書式で希望の処理を行う事ができました。
できましたが、この条件付き書式がどういう仕組みで重複をカウントしているのかさっぱり分かりません。
もしご面倒でなければご教示頂けませんでしょうか。

>>
>3.シート1日〜31日のB10〜G40内に重複するシフトコードが入っている場合は、

                            ↑
              Q40の間違いですか?

すみません、仰る通りQ40の間違いでした。

(ぺんた) 2017/05/28(日) 14:06


すみません、希望の処理を行う事ができたと書きましたが、
E20に138と入力し、B10のデータと重複させてみたところ
B10とE15に色がつき、重複しているE20には色がつきませんでした。
なお、E15にはINDIRECT関数により151というコードが入っており、138と重複しておりません。
(ぺんた) 2017/05/28(日) 14:22

 こちらでは、ちょっと分かりません。

 B10 と E20 が本当に同じか確認したいので
 どこか空いているセルに下の数式を入れてみてください。

 =IF(B10=E20,"同","異")&"#"&LEN(B10)&"桁"&B10&"#"&LEN(B10)&"桁"&E20&"#"

 同じならこう出るハズですが、そうなりますか?
      ↓
         同#3桁138#3桁138#

(半平太) 2017/05/28(日) 15:42


 >=IF(B10=E20,"同","異")&"#"&LEN(B10)&"桁"&B10&"#"&LEN(B10)&"桁"&E20&"#"

 間違えました m(__)m                  正
                             ↓
  =IF(B10=E20,"同","異")&"#"&LEN(B10)&"桁"&B10&"#"&LEN(E20)&"桁"&E20&"#"

(半平太) 2017/05/28(日) 16:34


>>半平太さん

>=IF(B10=E20,"同","異")&"#"&LEN(B10)&"桁"&B10&"#"&LEN(E20)&"桁"&E20&"#"

↑を空いているセルに入れてみたところ、同#3桁138#3桁138#と表示されました。
(ぺんた) 2017/05/28(日) 18:20


 >同#3桁138#3桁138#と表示されました。

 そうなると、考えられるのは、
 他の条件付き書式の方が優先度が高いからじゃないですか?

 テストの為だけですけど・・・

 1. こっちの条件付き書式の優先順位を最上位に上げてください。

 2.「□ 条件を満たす場合は停止」にチェックが入っていたら、チェックを外してください。

(半平太) 2017/05/28(日) 19:09


何度もすみません
テストの為に、

>>1. こっちの条件付き書式の優先順位を最上位に上げてください。
>>2.「□ 条件を満たす場合は停止」にチェックが入っていたら、チェックを外してください。

↑について、ワークシート全体から半平太さんに教えて頂きました
>>「B10:Q44」をドラッグ選択して、条件数式を以下として設定する。
>>=COUNTIF($B$10:$Q$40,(INDEX($A1:$Q44,INT(ROW()/5)*5,COLUMN())&"")*1)>=2
以外の条件式を削除してテストしてみましたが、
変化ありませんでした。
参考になるか分かりませんが、B10とB15に138と入力するとどのセルも色が変わらず、B10とB20に138と入力するとB10とB15(空欄です)の色が変わりました。
また、B10に101と入力すると、B10とF15の色が変わりました。F15にはINDIRECTにより131が表示されていますが、F15の値を削除してもB10とF15の色は変わったままになっています。

試してみた感じですと、同一行の重複データについては判別しているようですが、別の行にある重複データについては重複を検出できず、他の重複していないデータを重複データと判別してしまうようです。
表内のデータは直打ちのものもあればINDIRECTやVLOOKUPを使って他のシートから値を引っ張ってきているものもあります。
(ぺんた) 2017/05/29(月) 10:54


 済みません。行番号を絶対参照にするのを忘れました。 m(__)m

 >=COUNTIF($B$10:$Q$40,(INDEX($A1 :$Q44 ,INT(ROW()/5)*5,COLUMN())&"")*1)>=2

 正=COUNTIF($B$10:$Q$40,(INDEX($A$1:$Q$44,INT(ROW()/5)*5,COLUMN())&"")*1)>=2
                  ↑  ↑
                 $  $マーク

(半平太) 2017/05/29(月) 11:44


ありがとうございます。
ご指示頂いた部分を修正しましたところ、無事重複データを判別するようになりました。
(ぺんた) 2017/05/29(月) 13:01

 以上で、タイトルにあった「重複セルに色をつける方法」は解決ですね?

 あとは、この部分ですか?
       ↓
 >1.シート1日〜31日の土曜日はB3を青、日曜と祝日はB3を赤にする 
 >2.シート1日〜31日の土日祝日はH5〜Q44を赤にする 
 >3.シート1日〜31日の土日祝日でも5行目のコードが808(希望休)以外であれば、その列は赤くしない 

 これについては、パオ〜〜ンさんが何か考えていたようなので、当面そちらに譲ります。
 (タイムリーにレスが付かない様なら、私も考えます)

(半平太) 2017/05/29(月) 14:14


ペンタさま

半平太さんのご指名により、今悪戦苦闘?中です。(^^;;
しばしお待ち下さい。 m(_ _)m
P.S.
追加でご教示ください。

・祝日シートの作りはA2〜下へ祝日の日付が並んでいると思っていますが、
それでよろしいでしょうか?

・808について、B列〜I列については、どう扱うのでしょうか?
H列以降は土日祝日に色を付けないと思いますが

・土曜日と祝日が重なった場合は赤?青?
(パオ〜〜ン) 2017/05/29(月) 17:31


>>半平太さん

ありがとうございました。
重複セルに色をつける、につきまして解決とさせて頂きます。

>>パオ〜〜ンさま

お世話になります。
お手間をおかけしてすみませんが、宜しくお願い致します。
説明が全然足りていませんでしたので補足致します。

>・祝日シートの作りはA2〜下へ祝日の日付が並んでいると思っていますが、
それでよろしいでしょうか?

その通りです。
参考になるか分かりませんが、↓にスクリーンショットを上げましたので、
宜しければご覧下さい。

>・808について、B列〜I列については、どう扱うのでしょうか?
H列以降は土日祝日に色を付けないと思いますが
すみません、この部分に関連して3.の仕様を変えさせて下さい。

(変更前)3.シート1日〜31日の土日祝日でも5行目のコードが808(希望休)以外であれば、その列は赤くしない
(変更後)3.B5〜R5に808が入っている場合、入っている列の4行目〜44行目のセルを赤くする。

・土日祝でも5行目に808以外のコードが入っている場合は、入っている列の4〜44行目のセルを赤くしない。

仕様変更について簡単に説明させて頂きますと、B列〜G列は常勤スタッフの為土日祝関係なく仕事を回す必要があり、H列以降は非常勤スタッフの為土日祝はお休みなので、ぱっと見て分かるようにセルを赤くしたいと思っています。
H5〜R5には
=IF(COUNTIF(祝日一覧!$D$4:$D$31,$B$2)=1,808,IF(INDIRECT(TEXT($B$3,"aaaa")&"!"&COLUMN()&":"&ROW())=0,"",INDIRECT(TEXT($B$3,"aaaa")&"!"&COLUMN()&":"&ROW())))
という計算式が入っており、土日祝は808、平日は曜日シートのコードを引っ張ってくるようにしてあります。ただ、非常勤スタッフでも稀に土日祝勤務可能の場合があるので、その場合は5行目に手打ちで808以外のコードを入力するか空欄にするなどしてセルを赤くしたくないと考えています。

>・土曜日と祝日が重なった場合は赤?青?
B3についての事だと思いますが、土曜日と祝日が重なった場合赤でも青でも構いませんが、難しくなければ赤でお願い致します。複雑になるようでしたら青でも構いません。
H4〜R44については土曜日と祝日が重なった場合は赤でお願い致します。

途中まで考えて頂いているのに後から仕様変更ですみません。
セルに色をつける目的自体は変わらないのですが、考え方というか方法を変えた方がシンプルな気がしましたので変更させて頂きました。
宜しくお願い申し上げます。
(ぺんた) 2017/05/30(火) 10:18


ペンタさん

B5〜R5に808が入っている場合、入っている列の4行目〜44行目のセルを赤くする。
土日祝でも5行目に808以外のコードが入っている場合は、入っている列の4〜44行目のセルを赤くしない。

はマクロで実現すると808を入力後、毎回マクロを走らせなければならなくなり、操作が煩雑になります。
これは、5行目に808があれば、とにかくその列の4行目から44行目を赤にするということと
同じになると思います。(非常勤スタッフの方の部分にも式が入っていて、土日祝は808になるので)

なので、これは条件付き書式で実現される方が良いかと思います。
となると、実現するのは、土曜日青、日曜日、祝日赤だけですね。
これも条件付き書式で実現できそうですが....

それより、1日〜月末までのシートはどの様に作成されているのでしょうか?
それを作るのであれば、マクロも意味があり、そのときに、B3の色を決めるのはできます。

ある日の雛形を”原紙”として用意して、月の初めの日付を入れて一月分のシートを作るマクロはできています。

あるいは、不要かもしれませんが、参考までに

Sub Sample()
'
' Macro2 Macro
'

    Dim Sht As Worksheet
    Dim OSht As Worksheet
    Dim SSht As Worksheet
    Dim Idx As Integer
    Dim C As Range
    Dim DDt
    Dim Mm
    Dim Flg As Variant
'
    DDt = ""
    While Not IsDate(DDt)
        DDt = InputBox("月初の年月日を入力してください。(yyy/mm/1)", "年月日入力")
    Wend
    Idx = Sheets.Count
    Set OSht = Sheets("原紙")   ’日々のシートの雛形シートです。式等が入力済みです。
    Set SSht = Sheets("祝日一覧")

    Mm = Month(DDt)
    While Month(DDt) = Mm
        OSht.Copy after:=Sheets(Idx)
        Set Sht = ActiveSheet
        Sht.Name = Day(DDt) & "日"
        Sht.Range("B2").Value = DDt
'
        Flg = 0
        Application.ScreenUpdating = False
        With SSht
           .Cells.AutoFilter
           .Range("$A$1:$A$" & Rows.Count).AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(2, DDt)
            For Each C In Intersect(SSht.Range("A:A").SpecialCells(xlCellTypeVisible), SSht.Range("A:A").SpecialCells(xlCellTypeConstants))
                If C.Row > 1 Then
                    Flg = 1
                End If
            Next C
            .Cells.AutoFilter
        End With
        Application.ScreenUpdating = True

        If Flg = 1 Or Sht.Range("B3") = "日曜日" Then
            Sht.Range("B3").Interior.ColorIndex = 3
        Else
            If Sht.Range("B3") = "土曜日" Then
                Sht.Range("B3").Interior.ColorIndex = 5
            End If
        End If
        Idx = Idx + 1
        DDt = DateValue(DDt) + 1
    Wend
End Sub
(パオ〜〜ン) 2017/05/30(火) 11:38

>>パオ〜〜ンさま

1日〜月末までのシートの作成方法ですが、
・1日シートと同じものを31日分用意する
・2日シートB2セルに=1日!B2+1、3日シートB2セルに=1日!B2+2、4日シートB2セルに=1日!B2+3…
・1日シートB2セルに年月日を入力すると、2日以降のシートに日付が表示される
上記のようにしてあります。

ただ、日付と曜日の更新だけなら上記で完了しますが、肝心のシフト内容について、B5〜R44までのコード欄(5の倍数行)にINDIRECTで曜日シートの基本内容を引っ張ってあるものもあればコードを手打ちで入力してある部分もありますので、月初に1日シートの内容を曜日シートから引っ張るように修正した上で、1日シートの内容を2日〜31日までのシートにコピペしています。
マクロで簡単に作成できればとても助かります。1日〜31日のシートを一旦削除し、原紙シート(内容は1日シートのもの)を用意した上でご提案頂きましたマクロを実行してみましたところ、以下のエラーが表示されました。

『実行時エラー '1004':

選択されたセル範囲に対して、この操作を実行することはできません。対象データの範囲の中にあるセルの1つを洗濯してから、もう一度お試しください。』
とエラーが表示され、デバッグボタンを押すと

『For Each C In Intersect(SSht.Range("A:A").SpecialCells(xlCellTypeVisible), SSht.Range("A:A").SpecialCells(xlCellTypeConstants))』

がハイライト表示されます。ワークシートは1日シートのみ作成されました。
また、マクロを何度か試していたところ次のエラーが表示される場合もありました。

『実行時エラー '1004':

該当するセルが見つかりません』

『For Each C In Intersect(SSht.Range("A:A").SpecialCells(xlCellTypeVisible), SSht.Range("A:A").SpecialCells(xlCellTypeConstants))』

説明がうまくなくて分かりづらいと思いますが、宜しくお願い致します。
(ぺんた) 2017/05/30(火) 16:46


ペンタさま

申し訳ありません。昨日は休暇を頂いていて、返事が遅くなりました。

ご指摘のエラー部分は、祝日かどうかをチェックしているロジックで、ブック中に「祝日一覧」シートがないとこのようなメッセージが出るのではないかと推測します。

「祝日一覧」シートを入れて再度テストをお願いできませんでしょうか?
(パオ〜〜ン) 2017/06/01(木) 12:01


>>パオ〜〜ンさま

決して急がせているつもりはないのですが、
気を遣わせてしまっておりましたら申し訳ありません。
お時間のある時にお返事頂ければ十分ですので、宜しくお願い致します。

マクロを見た感じですと「祝日一覧」というシート名が見当たらず、どのような仕組みで祝日一覧シートを参照されているのか分かりませんが、「祝日一覧」シートにつきましては一度も削除せずマクロを実行しております。
(ぺんた) 2017/06/01(木) 14:44


ペンタさま

申し訳ありません。
祝日一覧の形式が合っていないのかもしれません。
いずれにしても、止まっている処理は祝日かどうかをチェックしている処理で、「祝日一覧」シートでオートフィルターをかけ、処理日があるかどうかを聞いています。
申し訳ありませんが、マクロの以下の部分を

       With SSht
           .Cells.AutoFilter
           .Range("$A$1:$A$" & Rows.Count).AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(2, DDt)
            For Each C In Intersect(SSht.Range("A:A").SpecialCells(xlCellTypeVisible), SSht.Range("A:A").SpecialCells(xlCellTypeConstants))
                If C.Row > 1 Then
                    Flg = 1
                End If
            Next C
            .Cells.AutoFilter
        End With

次のように置き換えてご確認願えないでしょうか?

        With SSht
            For I = 2 To .Range("A" & Rows.Count).End(xlUp).Row
                If .Cells(I, 1) = DDt Then
                    Flg = 1
                    Exit For
                End If
            Next I
        End With

よろしくお願いいたします。
(パオ〜〜ン) 2017/06/01(木) 16:10


>>パオ〜〜ンさま

早速ありがとうございました。
ご指示頂きました箇所を置き換えましたところ、無事ワークシートが作成されました。
今までちまちま手作業で行っていたものが自動で作成されていくのは壮観でした。
30日の月は31日のシートが作成されない点も痒い所に手が届く仕様だと思います。
(ぺんた) 2017/06/01(木) 17:23


ペンタさま

日付の入力を1日としてもらうことで固定していました。バグ?とまでは言えないまでも1ヶ月全体を作らないので修正し、マクロの意味もコメントしています。
ご笑納ください。

Sub Sample()
'
' Macro2 Macro
'

    Dim Sht As Worksheet
    Dim OSht As Worksheet
    Dim SSht As Worksheet
    Dim Idx As Integer
    Dim I   As Integer
    Dim C As Range
    Dim DDt
    Dim Mm
    Dim Flg As Variant
'
    DDt = ""                                                                                '日付を受け取る場所のクリア
    While Not IsDate(DDt)                                                                   '日付と認められるものが入力されるまで繰り返す
        DDt = InputBox("初日の年月日を入力してください。(yyyy/mm/01)", "年月日入力")       '日付入力依頼
    Wend
    DDt = CDate(Year(DDt) & "/" & Month(DDt) & "/1")                    '入力された日を強制的にその月の1日とする
    Idx = Sheets.Count                                                                      'Idxに現在のシート数を格納
    Set OSht = Sheets("原紙")                                                               '原紙をOShtで表す、
    Set SSht = Sheets("祝日一覧")                                                           '祝日一覧をSShtで表す。

    Mm = Month(DDt)                                                                         'Mmに入力した日付の月を格納
    While Month(DDt) = Mm                                                                   '日付が増えていったときに、入力の月と同じ間処理を行う
        OSht.Copy after:=Sheets(Idx)                                                        '原紙を最後のシートの後にコピーする
        Set Sht = ActiveSheet                                                               'コピーしたシートをShtで表す。
        Sht.Name = Day(DDt) & "日"                                                          'Shtの名前を日にち+”日”とする
        Sht.Range("B2").Value = DDt                                                         'ShtのB2に日付を格納する
'
        Flg = 0                                                                             '祝日を調べるためのFlgを用意し、クリアする
        Application.ScreenUpdating = False                                                  '画面を動かさないモードで
        With SSht                                                                           '祝日一覧シートについて
            For I = 2 To .Range("A" & Rows.Count).End(xlUp).Row                             'Iを2から、祝日一覧のA列の最後まで繰り返す
                If .Cells(I, 1) = DDt Then                                                  '祝日一覧が処理日と等しい場合
                    Flg = 1                                                                 'Flgに1を入れて
                    Exit For                                                                'For I=〜のループから抜け出る
                End If
            Next I                                                                          'For I=〜のループをIに1を加算して行う
        End With
        Application.ScreenUpdating = True                                                   '画面を動かすモードで

        If Flg = 1 Or Sht.Range("B3") = "日曜日" Then                                       'Flgが1か処理中のシートのB3が”日曜日”なら
            Sht.Range("B3").Interior.ColorIndex = 3                                         '処理中のシートのB3の色を赤にする
        Else
            If Sht.Range("B3") = "土曜日" Then                                              '処理中シートのB3が”土曜日”なら
                Sht.Range("B3").Interior.ColorIndex = 5                                     '処理中のシートのB3の色を青にする
            End If
        End If

        Idx = Idx + 1                                                                       'Idxに1を加える
        DDt = DateValue(DDt) + 1                                                            '処理日を次の日にする
    Wend

End Sub
(パオ〜〜ン) 2017/06/02(金) 11:18


>>パオ〜〜ンさま

返事が遅れてしまい申し訳ありません。
マクロの各意味についてとても分かりやすくコメントを入れて頂きありがとうございます。

3.B5〜R5に808が入っている場合、入っている列の4行目〜44行目のセルを赤くする。
の部分につきましては、B4〜R44の条件付き書式を
「=INDIRECT(ADDRESS(INT(ROW()/100)+5,COLUMN()))=808」
とする事で、少し動かしてみた感じですと希望の動きをしているように思います。
上記計算式についてはB〜Rの各列で5行目の値を返す式が全く検討もつかなかったのですが、半平太さんに教えて頂いた条件付き書式をヒントに試行錯誤の上どうにかたどり着きました。一見問題無く動いているように思うのですが、これで良かったでしょうか?
(ぺんた) 2017/06/05(月) 15:52


ぺんたさま

半平太さんが造られた式ですし、問題なく動いているのであれば、良いと思います。
私は単にマクロで毎日分を簡単に出るように下だけですから。。。(笑)
(パオ〜〜ン) 2017/06/05(月) 17:09


>>パオ〜〜ンさま

パオ〜〜ンさまのマクロのおかげで作業時間が何分の一…どころか一瞬で終わってしまうようになりました。手作業ですると知らない間にコピペミスをしている事も多々ありましたので本当に助かっています。こんな素晴らしいマクロを作って頂いて恐縮するばかりです。ありがとうございました。

>>半平太さん

問題が解決したのにすみません。
半平太さんに教えて頂いた数式ですが、
>=COUNTIF($B$10:$Q$40,(INDEX($A1:$Q44,INT(ROW()/5)*5,COLUMN())&"")*1)>=2
の「&"")*1」はどういう目的で入っているのでしょうか?
「&""」の意味から既に分かりませんでしたが、調べてみるとこれをつける事でINDEXの値が文字列に変換さる為、空白の時に0と表示されないとの事でした。でもその後「*1」とする事で、文字列から数値に変換されているように思います。また、空白の時に#VALUEとなるようにも思えます。
正直私にはちんぷんかんぷんな数式で、どうにか理解しようと調べてはみましたが「INT〜」の部分がどうやら5の倍数行目から5行分が1セットで1シフトになっているのをカバーする為だろうという事ぐらいしか分からず、どうにも頭がついていきません。もし差支えなければお時間のある時で構いませんので、後学の為にこの数式で重複をどのように拾っているのか仕組みをご教示願えませんでしょうか?

あと、今回のシフト表はたまたま5の倍数行目から5行分が1セットで1シフトになっているので、5で割って5をかける事で1シフトをカバーできていますが、例えば…これは適当ですが、7行目から4行分が1セットで1シフトになっていた場合、カバーできる数式というのはあるんでしょうか?
(ぺんた) 2017/06/06(火) 11:07


 >「&""」の意味から既に分かりませんでしたが、
 >調べてみるとこれをつける事でINDEXの値が文字列に変換さる為、
 >空白の時に0と表示されないとの事でした。

 その調査結果は、よく使われるケースとしては正しいです・・が、
 私の最終的な意図ではありません。

 既に空白文字が入っていれば、(&"")は不要ですが、
 未入力の場合もあるかも知れないので、どちらのケースにも対応できるようにしたものです。

 その結果、空白文字または未入力は「空白文字」になります。

 >でもその後「*1」とする事で、
 >文字列から数値に変換されているように思います。
 >また、空白の時に#VALUEとなるようにも思えます。 

 正に、それが望むところなのです。

 数値は数値となる。→ 自分と同じものになる(バカバカしい程、当たり前です) 
 空白または空白文字は「数値の0ではなく、エラー」になる。→ 自分とは全く違うものになる!

 表中にエラーなんか無いですから、COUNTIFでエラーを数えさせれば、一つも無い(自分さえ無い)。
 この為、空白が幾つあっても重複とは判定されず、色が付かない事になります。

 >あと、今回のシフト表はたまたま5の倍数行目から5行分が1セットで1シフトになっているので、
 >5で割って5をかける事で1シフトをカバーできていますが、
 >例えば…これは適当ですが、7行目から4行分が1セットで1シフトになっていた場合、
 >カバーできる数式というのはあるんでしょうか?

 階段状の処理は、他にもFLOOR関数を使うことが考えられます。
  =INT(ROW()/5)*5 、 =FLOOR(ROW(),5)

 4行1シフトなら
  =INT(ROW()/4)*4、  =FLOOR(ROW(),4)

 あとは、初期値をアジャストするだけです。

 >7行目から4行分が1セットで1シフトになっていた場合
 7を4に引きずり下ろしてから、引いた分だけ足す。
  =INT((ROW()-3)/4)*4+3 、 =FLOOR(ROW()-3,4)+3

(半平太) 2017/06/06(火) 21:25


 >>半平太さん

 なんというか、凄過ぎます。
 これだけ凄いのですから、はじめに頂いた回答でどこがそんなに難しいのか逆に質問されていたのにも納得です。
 解説もとても分かりやすくて、自分には目から鱗であったり驚いたりする事ばかりでした。お忙しい中ご教示いただきありがとうございました。
(ぺんた) 2017/06/07(水) 10:44

 >>半平太さん

 すみません、過去ログを読んで敬称を改めさせて頂きました。
 重複チェックについて大変お世話になりました。その後運用しておりますが、
 問題なく動作しておりとても助かっています。

 実際に運用していて2点ほど機能を追加できないかと思い、ご質問させて頂きたいと思います。
 タイトルの件については解決しましたので新しく投稿し直すべきか迷いましたが、
 こちらに追記させて頂く事にしました。問題がありましたら投稿し直したいと思います。

 5.列B〜列Gの従業員について、8:30〜17:30以外の勤務時間の場合は該当列の9行目に
   シフトに合わせた勤務時間を表示する。(勤務時間の判定方法は後述)
 6.各シフトについて、移動時間が15分未満の場合はそのシフトに色をつける。

 上記について補足させて頂きます。
 5.についてですが、弊社では8:30〜17:30が定時となっておりますが、1件目のシフトの開始時刻が
 8:30よりも早い場合、1件目の開始時刻の15分前を勤務開始時刻としております。
 (例:1件目が8:30であれば勤務開始時刻は8:15、1件目が8:00であれば勤務開始時刻は7:45)
 例外でシフトコード138、233、453、531のシフトから始まる場合は8:30から勤務開始としたいですが、
 これは多分無理だと思うので手入力で対応しようと思います。
 勤務終了時刻について、定時以外の場合は勤務開始時刻から9時間後を勤務終了時刻とするが、
 最後のシフトが17:30を超えている場合は、最後のシフトの終了時刻の15分後を勤務終了時刻とする。
 また、勤務終了時刻が17:30を超える場合は、勤務開始時刻を勤務終了時刻の9時間前にする。
 弊社では1年単位の変形労働時間制を採用しており、日々のシフトはなるべく9時間拘束で
 シフトを組んでおりますが、どうしても組めない場合は超過勤務分を他の日で調整しています。
 超過勤務分の調整については手作業で行うしか無いと諦めていますので、シフト内容によって勤務時間だけでも
 9行目に表示できればいいなと考えています。(現在はシフトを見て手作業で勤務時間を入力しています)
 最初のシフトが必ず10行目、最後のシフトが必ず40行目から始まっている訳ではないのでややこしいかも知れません。

 6.についてですが、どのお宅でも大体30分の移動時間があれば十分ですが、場合によっては
 15分あれば良い事もあるので、最低15分の移動時間が確保できていない場合、当該シフトのセルに
 色をつけたいと考えています。
 移動時間というのは、あるシフトの終了時刻からその次のシフトの開始時刻までの間の時間を言います。
 なお、シフトのすぐ下に次のシフトが入っているとは限らず、何シフト分か開けて次のシフトが
 入っている場合もあります。

 後から思い付きの仕様追加ですので重複チェックにおける計算式が無駄にならないか心配です。
 情報が不十分で分かりにくかったらすみません。
(ぺんた) 2017/06/09(金) 17:17

仕上がりのイメージはこのような感じです。

宜しくお願い申し上げます。
(ぺんた) 2017/06/09(金) 17:31


 なんか、ややこしいですね。

 マクロ(と条件付き書式の併用)じゃないと無理です(私には、ですけど)

 > 5.列B〜列Gの従業員について、

 ・・と言うことは、6名分ですね?
 前回みたいに、B〜Q が正しいと言うことはないですね?

 > 例外でシフトコード138、233、453、531のシフトから始まる場合は8:30から勤務開始としたいですが、
 > これは多分無理だと思うので手入力で対応しようと思います。

 マクロならそう言うのにも対応できます。

 因みに、例外コードを考慮するのは開始時刻だけですね?
 終了時刻の延長が必要なとき、そのコードかどうか考慮する必要はないと理解。

 >どうしても組めない場合は超過勤務分を他の日で調整しています。
 >超過勤務分の調整については手作業で行うしか無いと諦めています

 回答側にとって、どう云う意味があるのか分からないので、そこはスルーします。
 対応するのは此処のみ。
        ↓
 >シフト内容によって勤務時間だけでも 9行目に表示

 >最低15分の移動時間が確保できていない場合、当該シフトのセルに
 >色をつけたいと考えています。

 これは、移動後に行くシフトだけ色を付けるのですね?(通常、下の方にあるシフト)

 >重複チェックにおける計算式が無駄にならないか心配です。

 前回の様に、塊り状態の(複数の)セルに色付けするんですか?
 シフト時間が入力された一つのセルだけでいい様な気がするんですが?

 仮に塊り状態で付けるとして、重複の色付けとどっちが優先なんですか?
 (もしかして同じ色? それだと色が付いても原因が分かりにくくなりますよ?)

(半平太) 2017/06/10(土) 22:20


 >>半平太さん

 お世話になっています。
 ご質問頂きました点、以下のとおり回答させて頂きます。

 >・・と言うことは、6名分ですね?
 6名分で間違いありません。その6名がフルタイムの従業員です。

 >因みに、例外コードを考慮するのは開始時刻だけですね?
 >終了時刻の延長が必要なとき、そのコードかどうか考慮する必要はないと理解。
 開始時刻だけで大丈夫です。終了時刻の延長は年1回ぐらいですので、その時は手作業で対応しようと思います。

 >回答側にとって、どう云う意味があるのか分からないので、そこはスルーします。
 今日8時間15分の勤務だった場合、前後の出勤日の勤務時間を8:45〜17:30または8:30〜17:15として調整したいところですが、
 8:30からのシフトが入っていれば8:45の出勤では間に合わず、17:30までのシフトが入っていれば17:30に退社ができないので、
 他の日で調整するしか無いと思いますが、そのような人間的?な動作は機械には難しいだろうと思いましたので、
 超過勤務分の調整は手作業でしかできないと思った次第です。
 マクロでできるのであればそれに越した事はないのですが、相当ややこしいのではと思います。

 >これは、移動後に行くシフトだけ色を付けるのですね?(通常、下の方にあるシフト)
 できれば移動前と移動後両方のシフトに色が着くとありがたいですが、複雑でしたら移動後だけでも結構です。

 >シフト時間が入力された一つのセルだけでいい様な気がするんですが?
 塊状態のセルに色をつける事しか頭になかったのですが、仰る通り色がついても分かりにくくなりますので
 シフト時間が入力されたセルだけ色がつくようにお願い致します。

 ややこしい事ばかり書いてすみませんが、宜しくお願い申し上げます。
(ぺんた) 2017/06/16(金) 13:22

  >開始時刻だけで大丈夫です。終了時刻の延長は年1回ぐらいですので、
  >その時は手作業で対応しようと思います。
  手入力の情報が正しいこともある事になりますので、
  勤務時間を9行目に自動的に表示させることは出来ない。

  ・・なので、機械計算値で書換えていいかユーザーに対して問合わせをする作りになります。

  >そのような人間的?な動作は機械には難しいだろうと思いましたので
  ロジカルに出来る事は、可能と言えますが、
  そのロジックを整理したり、表の作りを再構築する必要も出るかも知れませんので、
  今回は、そこまで深入りしません。

  >できれば移動前と移動後両方のシフトに色が着くとありがたい
  両方にする方が少し簡単です。どっちが先なのか考える必要がなくなるので。

  >シフト時間が入力されたセルだけ色がつくようにお願い致します。
  そのセルの条件付き書式を最優先に設定してうださい。
  赤地に黄色文字なんかがいいと思いますが、セル色はそちらで設定してください。

  設定範囲(適用先)→ =$B$12:$Q$12,$B$17:$Q$17,$B$22:$Q$22,$B$27:$Q$27,$B$32:$Q$32,$B$37:$Q$37,$B$42:$Q$42
  条件数式     → =RIGHT(B12,1)=" "
                                    ↑
                  半角スペース(マクロでこのスペースを付加します)

  例:先のシフトが「8:20-8:46」  で後のシフトに「9:00-9:45」 と入力すると、その途端に
    先のシフトが「8:20-8:46□」、 後のシフトは「9:00-9:45□」にマクロが強制的に書換えます。

  後記マクロは「ThisWorkBookモジュール」に貼り付けてください。(重要)

  ※ブック内には、シフトと関係のないシートは存在しないと想定しております。
   もし存在する場合は、そのシートのセルを変更してもマクロが作動してしまいますので、
   適用除外措置をするコードが必要になります。

 ’ThisWorkBookモジュールに貼り付けるマクロ↓

 Private Type SftBlock
     Code As Variant      'シフトコード
     OrgZone As Variant   '例→9:00-10:00

     FromOrg  As Date     '訪問開始時刻
     ToOrg As Date        '訪問終了時刻
     ToPlusMove As Date   '移動時間込み("0:14"プラス)

     FromMod  As Date     '訪問開始修正後時刻
     ToMod As Date        '訪問終了修正後時刻

     onDuty As Boolean
     overLap As Boolean
     CellAdrs As String
 End Type

 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
     Dim BaseRng As Range
     Dim rngToProc As Range
     Dim cel As Range
     Dim NN

     Application.ScreenUpdating = False

     Set BaseRng = Range("B10:Q10,B12:Q12") '第一ブロック全範囲
     Set rngToProc = BaseRng

     For NN = 1 To 6
         Set rngToProc = Union(rngToProc, BaseRng.Offset(NN * 5))
     Next NN

     Set rngToProc = Intersect(rngToProc, Target) '総ブロック全範囲

     If Not rngToProc Is Nothing Then  '変更セルが、コードまたは作業時刻か
         For Each cel In rngToProc
             Call figureDuration(cel.Column)
         Next
     End If

     Application.ScreenUpdating = True
 End Sub

 Private Sub figureDuration(colNum As Long)
     Const nutralCodes As String = ",138,233,453,531,"
     Dim posInNutral As Long
     Dim Appeared As Boolean   '当日勤務あり
     Dim timeToDisp As Variant
     Dim Earliest As Date
     Dim Latest As Date
     Dim SFTs(1 To 7) As SftBlock
     Dim colToProc As Range
     Dim KK As Long, Idx As Long
     Dim VisitZone, ZoneAry
     Dim shouldReWrite As Boolean

     Earliest = 2  'Dummy入力
     Latest = 0

     Set colToProc = Cells(1, colNum).Resize(44)

     'データ格納
     For Idx = 1 To 7
         With SFTs(Idx)
             .Code = Cells(10, colNum).Value
             .CellAdrs = colToProc.Cells(Idx * 5 + 7, 1).Address

             VisitZone = StrConv(Trim(colToProc.Cells(Idx * 5 + 7, 1).Value), vbNarrow) '例→9:00-10:00
             VisitZone = Replace(VisitZone, "~", "-") '[〜]は→[-]へ強制変換
             .OrgZone = VisitZone

             If VisitZone Like "*:*-*:*" Then '時刻入力あり
                 .onDuty = True     '当該ブロックは勤務あり
                 Appeared = True              '当日勤務あり

                 ZoneAry = Split(VisitZone, "-")

                 '開始の方が終了より遅い(=入力ミス) → オーバーラップと同じ扱いとする
                 .overLap = CDate(ZoneAry(1)) <= CDate(ZoneAry(0))

                 .FromOrg = CDate(ZoneAry(0))
                 .ToOrg = CDate(ZoneAry(1))
                 .ToPlusMove = CDate(Format(CDate(ZoneAry(1)) + TimeValue("0:14"), "h:nn"))

                 posInNutral = InStr(nutralCodes, "," & .Code & ",")

                 '開始前・終了後の移動時間調整
                 .FromMod = .FromOrg - IIf(posInNutral = 0 And .FromOrg <= TimeValue("8:30"), TimeValue("0:15"), 0)
                 Earliest = Application.Min(Earliest, .FromMod)

                 .ToMod = .ToOrg + IIf(.ToOrg > TimeValue("17:30"), TimeValue("0:15"), 0)
                 Latest = Application.Max(Latest, .ToMod)

             End If
         End With
     Next Idx

     'オーバーラップをブロック単位で相互判定
     For Idx = 1 To 6
         With SFTs(Idx)
             If .onDuty Then '作業ありブロックのみ処理
                 For KK = Idx + 1 To 7
                     If SFTs(KK).onDuty Then
                         If .FromOrg <= SFTs(KK).ToPlusMove And SFTs(KK).FromOrg <= .ToPlusMove Then
                             SFTs(KK).overLap = True
                             .overLap = True
                         End If
                     End If

                 Next KK
             End If
         End With
     Next Idx

     '条件付き書式用に空白文字を付加する
     For Idx = 1 To 7
         With SFTs(Idx)
             Application.EnableEvents = False
             Range(.CellAdrs) = .OrgZone & IIf(.overLap, " ", "")
             Application.EnableEvents = True
         End With
     Next Idx

     Rem 以下、フルタイムの職員のみ処理

     If 1 < colNum And colNum < 8 Then
         '勤務時間帯を計算して入力する
         If Appeared Then
             If Earliest < TimeValue("8:29:30") Then
                 If TimeValue("17:30:30") < Latest Then
                     timeToDisp = Format(Earliest, "h:nn") & "-" & Format(Latest, "h:nn")
                 Else
                     timeToDisp = Format(Earliest, "h:nn") & "-" & _
                     Format(Application.Max(Latest, Earliest + TimeValue("9:00")), "h:nn")
                 End If
             ElseIf TimeValue("17:30:30") < Latest Then
                 timeToDisp = Format(Application.Min(Earliest, Latest - TimeValue("9:00")), "h:nn") & "-" _
                 & Format(Latest, "h:nn")
             Else
                 timeToDisp = "8:30-17:30"
             End If
         Else
             timeToDisp = Empty
         End If

         If Cells(9, colNum).Value = Empty Then
             shouldReWrite = True
         ElseIf Cells(9, colNum).Value <> timeToDisp Then
             If vbYes = MsgBox("9行目の勤務時刻を変更します。" & vbCrLf & vbCrLf & Cells(9, colNum).Value & "(現在)" & vbCrLf & timeToDisp & "(変更後)", vbYesNo) Then
                 shouldReWrite = True
             End If
         End If

         If shouldReWrite Then
             Application.EnableEvents = False
             Cells(9, colNum).Value = timeToDisp
             Application.EnableEvents = True
         End If
     End If

 End Sub

(半平太) 2017/06/16(金) 17:03 後日、条件付き書式範囲関連、修正済み(6/21 17:10)


 すみません、先週から出張しておりましたまだ半平太さんのマクロと条件付き書式を試せておりませんが、
 半平太さんの条件付き書式を拝見し、恐らくこちらの意図が正しく伝えられていなかったと思いましたので補足致します。
 勤務時間の調整を行いたいのはB〜Gの6名ですが、移動時間のチェックを行いたいのはB〜Qの16名全員です。
 半平太さんの質問の意図を誤解してしまい申し訳ありません。
(ぺんた) 2017/06/21(水) 11:28

 そうなると、条件付き書式の適用範囲やらに若干の影響が出ます。

 再度、同じようなものをアップするのは、スペースの浪費感もありますので、
 金曜日にアップしたレスを全面差し替えにしておきます。

(半平太) 2017/06/21(水) 17:14


 余分な手間をおかけしてしまい大変申し訳ありません。
 宜しくお願い申し上げます。
(ぺんた) 2017/06/21(水) 17:31

 あのー、書き換えは終わっているんですけど。(金曜日のでやってください)

(半平太) 2017/06/21(水) 18:41


 6/23の金曜日に差し替えして頂けるのかとわくわくしていました。すみません。
 今試してみたのですが、どのコードを入力しても「実行時エラー'5':プロシージャの呼び出し、または引数が不正です」とのエラーが表示されました。
 プログラムの該当箇所は、
 Earliest = Application.Min(Earliest, .FromMod)
 この部分です。
 それと、除外するシートについてご依頼があります。
 このブックには日付のシートと曜日のシート、休日一覧シート、従業員一人一人のシート、フルタイム従業員の勤務割一覧表、コード一覧シートがあり、
 移動時間のチェックと勤務時間の調整は日付のシートと曜日のシートのみで行いたいと考えています。

 何か不足している情報や試す事がありましたらご指示ください。
(ぺんた) 2017/06/22(木) 11:24

 <こちらで想定している状況>とはかなり違うようですね。
  ↓
  行  _____B_____  _____C_____  _____D_____
   4  社員01       社員02       社員03     
   5                                       
   6                                       
   7                                       
   8                                       
   9  8:00-17:00   8:15-17:15   8:05-17:30 
  10   34          139           123
  11  氏名01       氏名01       氏名02     
  12  8:15-9:30    8:30-9:00    8:20-8:45  
  13                                       
  14                                       
  15                             152
  16                            氏名03     
  17                            9:00-9:45  
  18                                       
  19                                       
  20                             234
  21                            氏名04     
  22                            10:15-17:30

 (1)9,10,12,15,17,22行で、明らかにそちらと違うイメージになっている箇所はありますか?

 (2)このブックの正式名称を教えてください。
   (差しさわりがある場合はスルーしてください)

 (3)トラブってデバックモードになった時
  「Earliest」と 「.FromMod」に何が入っているか教えてください
  (調べ方が分からなければスルーしてください)

 (4)曜日シートは今回の質問に直結するものですか?
  日付シートだけだと思っているのですが?

 (5)日付シート名は、「1日」とか「15日」と言う形式に必ずなっていますね?

(半平太) 2017/06/22(木) 13:28


 お世話になります。早速お返事頂きありがとうございます。

 >>(1)9,10,12,15,17,22行で、明らかにそちらと違うイメージになっている箇所はありますか?
 表のイメージは全く同じです。念の為再度申し上げますと、10,15,20行目にコードを手入力すると、
 シートmからvlookup関数で氏名や時間を表示するようになっています。

 >>(2)このブックの正式名称を教えてください。
 稼働管理表H29年7月.xlsxとしています。年と月はファイルごとに変わります。

 >>(3)トラブってデバックモードになった時
  「Earliest」と 「.FromMod」に何が入っているか教えてください
  (調べ方が分からなければスルーしてください)
 調べ方は分かりませんが、デバックモードの時にマウスカーソルを合わせたらEarliestには「1900/01/01」、.FromModには「8:15:00」が表示されました。

 >>(4)曜日シートは今回の質問に直結するものですか?
  日付シートだけだと思っているのですが?
 親記事の○2つめに記載させて頂いたつもりでしたが、うまく伝わらなかったと思いますので補足致します。
 曜日シートが日曜日〜土曜日まで作成してあり、各曜日シートにはそれぞれの曜日における基本シフトパターンが入っています。
 日付シートのB10・B15・B20・B25・B30・B35・B40には、各日付に対応する曜日シートのデータがindirect関数で表示されるようになっています。
 (同様にC列〜Q列までindirect関数が入っています)
 曜日シートの中身は日付シートと同じものを流用しています。
 当該稼働表を作成する際、まず曜日シートの基本シフトパターンを修正した上で、日付シートがそれらの曜日シートの内容を
 vlookupやindirectで表示するようにし、そこから従業員の希望休に応じて日付シートのシフトを微調整しております。
 ですので、はじめに曜日シートの基本シフトパターンを修正するタイミングで移動時間のチェックと勤務時間の調整を行い、
 その後従業員の勤務状況に応じて日付シートを調整する際にも移動時間のチェックと勤務時間の調整をしたいと考えています。

 >>(5)日付シート名は、「1日」とか「15日」と言う形式に必ずなっていますね?
 日付シートの名前は仰る通りの形式になっています。

 余談ですが、そもそも稼働表の構造がまずいんだと思います。
 日付シートや曜日シートの各セルにvlookupやindirect関数が入っていてだいぶ重たいので、
 コードを入れてからデータが表示されるのに5秒ぐらいかかってます。
 マシンスペックを上げる以外で何か改善できるような方法はありますでしょうか?
(ぺんた) 2017/06/22(木) 16:32

 > 余談ですが、そもそも稼働表の構造がまずいんだと思います。
 > 日付シートや曜日シートの各セルにvlookupやindirect関数が入っていてだいぶ重たいので、
 > コードを入れてからデータが表示されるのに5秒ぐらいかかってます。
 > マシンスペックを上げる以外で何か改善できるような方法はありますでしょうか?

 便利な機能を満載して、結果、不便になったと言う質問は、10年に数件あります。

 現在のPCスペックは十分高いと思います。昔のPCならとっくに使えなくなっているのに、
 スペックが上がった為に気付くのが遅くなる傾向にあります。
 そうなると、一つの原因を排除したくらいでは、効果が見えにくいなんてこともあります。

 こんなのを読んで、自分に当てはまるものが見つかるといいですね。
  ↓
 【Excel 2010 のパフォーマンス: 計算パフォーマンスの強化】
https://msdn.microsoft.com/ja-jp/library/office/Ff700515(v=office.14).aspx

 > 親記事の○2つめに記載させて頂いたつもりでしたが、うまく伝わらなかったと思いますので補足致します。
 全く、頭に残っておりません。m(__)m
 結論として、10行目と12行目は、数式が入っていると言うことですか。

 それだと、上の対策は意味を為しません。
 その行にコードや時間帯を手入力した時(イベント発生時)に作動するマクロですから。

 速度も遅くなっていると言うことを考えると、以前の(コード重複の)条件付き書式の色づけもマクロでやった方がいいと思います。

 ただ、そうすると普通の着色なので、既に「何らかの意味ある色」が付いている場合、それが消えてしまうので
 それらの色も、色付け条件の一つとして加える必要があります。

 マクロ方式に変更する決心がついたら、その色付け条件(もしあればですが)の説明をしていただく必要があります。

 それがまずい場合は、条件付き書式でやるとして、その条件が簡単になるようにマクロで事前処理を行う。
 具体的には、各列の50行目(場所は任意)以下に色を付けるべき行番号を書き出し、各セルの条件付き書式は
 自セルの行位置が、書き出されている行番号に合致するかだけ見て、色をづける。
 それだけでもざっと、延べ300,000セルを見に行かせていたところを10分の1以下に減らせます。

(半平太) 2017/06/23(金) 09:15


 もう一度、条件付き書式で出来ないか考えてみました。

 色付けする行番号をシート上には書かず、マクロを使って、
 名前定義の参照定数に直接書き込めば、上記と同じように計算量が減らせそうです。

 明日、時間が作れたら具体案を考えてみます。

(半平太) 2017/06/24(土) 23:41


 条件付き書式でやる方法
 ※この方法だと、いままで単純に付けていた色(もしあれば)は
  条件付き書式で色が付かなければ、そのまま色が残ります。

 1.以前の「コード重複用の条件付き書式」は消去してください。(重い原因の一つです)

 2.後記マクロをThisWorkBookモジュールに貼り付けてください。

 3.一旦他のシートをアクティブにしてから、目的の日付シートをアクティブにしてください。
   それがイベントとなって、2つの名前定義がマクロで自動作成されます。
   「重複」と「OVERLAP」です。いずれも、シート単位の名前定義です。

 4.以下の条件付き書式を設定してください。
  (1)重複用
   適用範囲 =$B$10:$Q$44
   条件式  =VLOOKUP((INDEX($A$1:$Q$44,INT(ROW()/5)*5,COLUMN())&"")*1,重複,2,FALSE)>=2

  (2)移動時間過少用 こちらの方が優先度は高い
   適用範囲 =$B$12:$Q$42
   条件式  =IF(ROW()-7-FLOOR(ROW()-7,5),0,INDEX(OVERLAP,(ROW()-7)/5,COLUMN()-1))

 以上で条件付き書式がワークして色がつくハズですが、通常の条件付き書式と違って、
 その後、シフトコードを変更してもそれに付随して色付けが変わる事はありません。

 シフトコードや、従業時刻の変更後に条件付き書式に反映させたい時は、以下の2つの方法のどちらかで行います。
 (1)上記3でやったように、一旦別のシートをアクティブにしてから、再び元のシートを「アクティブ」にする。
 (2)当該シートの9行目(B9:Q9)の何処かのセルを「右クリック」する。 

 ※(2)でやった時は、9行目の勤務時間の計算も同時に実行されます。(フルタイムの人だけ)
  再計算の結果、従来入っていた勤務時間と違う場合は、変更していいか確認を求めて来る様になっています。
  ただし、従来何も入っていない場合は、その確認はなく、計算した勤務時間が自動入力されます。

 ’ThisWorkBookモジュールに貼り付けるマクロ
 ’ ↓
 Private Type SftBlock
     Code As Variant      'シフトコード
     OrgZone As Variant   '例→9:00-10:00

     FromOrg  As Date     '訪問開始時刻
     ToOrg As Date        '訪問終了時刻
     ToPlusMove As Date   '移動時間込み("0:14"プラス)

     FromMod  As Date     '訪問開始修正後時刻
     ToMod As Date        '訪問終了修正後時刻

     onDuty As Boolean

 End Type

 Private Sub Workbook_SheetActivate(ByVal Sh As Object)  '日付シートのActivateイベント
 'コード重複の処理、オーバーラップ

     If Not StrConv(Right(0 & Sh.Name, 3), vbNarrow) Like "##日" Then
         Exit Sub
     Else
         Call DupliColoring(Sh, "アクティベート")
     End If
 End Sub

 Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
 'コード重複の処理、オーバーラップ、時間帯の計算
     If Target.Rows.Count > 1 Then Exit Sub

     If Intersect(Target, Range("B9:Q9")) Is Nothing Then
         Exit Sub
     ElseIf Not StrConv(Right(0 & Sh.Name, 3), vbNarrow) Like "##日" Then
         Exit Sub
     Else
         Cancel = True
         Call DupliColoring(Sh, "9行目右CLICK")
     End If
 End Sub

 Private Sub DupliColoring(ByVal Sh As Object, strCause As String)
     Dim valToProc
     Dim NN As Long, Col As Long
     Dim timeToDisp(2 To 7) As Variant
     Dim overLapMatrix(1 To 7, 1 To 16) As Integer
     Dim dicT As Object, cel As Range
     Dim ListW, Li, ErNum
     Dim shouldReWrite As Boolean

     Rem  状況調査1(コード重複)
     Set dicT = CreateObject("Scripting.Dictionary")

     valToProc = Range("B10:Q40").Value

     For NN = 1 To 31 Step 5
         For Col = 1 To 16
             If valToProc(NN, Col) <> "" Then
                 dicT(valToProc(NN, Col)) = dicT(valToProc(NN, Col)) + 1
             End If
         Next Col
     Next NN

     ListW = Application.Transpose(Array(dicT.keys, dicT.items))
     ListW = strRefersTo(ListW) '名前定義用の文字列に変換

     dicT.RemoveAll '用済みにつきクリア

     Rem シートレベル名前定義(重複)の参照定数を更新
     On Error Resume Next
     Sh.Names("重複").RefersToR1C1 = ListW
     ErNum = Err.Number
     On Error GoTo 0

     If ErNum <> 0 Then
         Sh.Names.Add Name:="重複", RefersToR1C1:=ListW
     End If

     Rem  状況調査2(時刻オーバーラップ)
     For Col = 2 To 17 'B列〜Q列まで
         Call figureDuration(Col, timeToDisp, overLapMatrix, strCause)
     Next Col

     ListW = strRefersTo(overLapMatrix) '名前定義用の文字列に変換

     Rem シートレベル名前定義(OVERLAP)の参照定数を更新
     On Error Resume Next
     Sh.Names("OVERLAP").RefersToR1C1 = ListW
     ErNum = Err.Number
     On Error GoTo 0

     If ErNum <> 0 Then
         Sh.Names.Add Name:="OVERLAP", RefersToR1C1:=ListW
     End If

     Application.ScreenUpdating = True

     'フルタイム職員の時間帯算出

     If strCause = "9行目右CLICK" Then
         For Col = 2 To 7
             If Cells(9, Col).Value = Empty Then
                 shouldReWrite = True '無条件で更新

             ElseIf Cells(9, Col).Value <> timeToDisp(Col) Then
                 If vbYes = MsgBox("9行目の勤務時刻を変更します。" & vbCrLf & vbCrLf & _
                 Cells(9, Col).Value & "(現在)" & vbCrLf & _
                     timeToDisp(Col) & "(変更後)", vbYesNo) Then
                     shouldReWrite = True
                 End If
             End If

             If shouldReWrite Then
                 Cells(9, Col).Value = timeToDisp(Col)
             End If
         Next Col

     End If

 End Sub

 Private Sub figureDuration(colNum As Long, ByRef timeToDisp, ByRef OLMtrx, strCause)
     Const nutralCodes As String = ",138,233,453,531,"
     Dim posInNutral As Long
     Dim Appeared As Boolean   '当日勤務あり
     Dim Earliest As Date, Latest As Date
     Dim SFTs(1 To 7) As SftBlock
     Dim colToProc As Range
     Dim KK As Long, Idx As Long
     Dim VisitZone, ZoneAry '開始-終了
     '
     Earliest = 2  'Dummy入力
     Latest = 0

     Set colToProc = Cells(1, colNum).Resize(44)
     '
     '    'データ格納
     For Idx = 1 To 7
         With SFTs(Idx)
             .Code = Cells(Idx * 5 + 5, colNum).Value

             VisitZone = StrConv(Trim(colToProc.Cells(Idx * 5 + 7, 1).Value), vbNarrow) '例→9:00-10:00
             VisitZone = Replace(VisitZone, "~", "-") '[〜]は→[-]へ強制変換
             .OrgZone = VisitZone

             If VisitZone Like "*:*-*:*" Then '時刻入力あり
                 .onDuty = True     '当該ブロックは勤務あり
                 Appeared = True              '当日勤務あり

                 ZoneAry = Split(VisitZone, "-")

                 .FromOrg = CDate(ZoneAry(0))
                 .ToOrg = CDate(ZoneAry(1))
                 .ToPlusMove = CDate(Format(CDate(ZoneAry(1)) + TimeValue("0:14"), "h:nn"))

                 posInNutral = InStr(nutralCodes, "," & .Code & ",")

                 '開始前・終了後の移動時間調整
                 .FromMod = .FromOrg - IIf(posInNutral = 0 And .FromOrg <= TimeValue("8:30"), TimeValue("0:15"), 0)
                 Earliest = Application.Min(Earliest, .FromMod)

                 .ToMod = .ToOrg + IIf(.ToOrg > TimeValue("17:30"), TimeValue("0:15"), 0)
                 Latest = Application.Max(Latest, .ToMod)

             End If
         End With
     Next Idx
     '
     '移動時間オーバーラップをブロック単位で相互判定
     For Idx = 1 To 6
         With SFTs(Idx)
             If .onDuty Then '作業ありブロックのみ処理
                 For KK = Idx + 1 To 7
                     If SFTs(KK).onDuty Then
                         If .FromOrg <= SFTs(KK).ToPlusMove And SFTs(KK).FromOrg <= .ToPlusMove Then
                             OLMtrx(Idx, colNum - 1) = 1
                             OLMtrx(KK, colNum - 1) = 1
                         End If
                     End If
                 Next KK
             End If
         End With
     Next Idx

     Rem 以下、フルタイムの職員のみ勤務時間計算処理
     If strCause = "9行目右CLICK" Then
         If 1 < colNum And colNum < 8 Then
             '勤務時間帯を計算して配列に一時格納する
             If Appeared Then
                 If Earliest < TimeValue("8:29:30") Then
                     If TimeValue("17:30:30") < Latest Then
                         timeToDisp(colNum) = Format(Earliest, "h:nn") & "-" & Format(Latest, "h:nn")
                     Else
                         timeToDisp(colNum) = Format(Earliest, "h:nn") & "-" & _
                         Format(Application.Max(Latest, Earliest + TimeValue("9:00")), "h:nn")
                     End If
                 ElseIf TimeValue("17:30:30") < Latest Then
                     timeToDisp(colNum) = Format(Application.Min(Earliest, Latest - TimeValue("9:00")), "h:nn") & "-" _
                     & Format(Latest, "h:nn")
                 Else
                     timeToDisp(colNum) = "8:30-17:30"
                 End If
             Else
                 timeToDisp(colNum) = Empty
             End If
         End If
     End If
 End Sub

 Private Function strRefersTo(ListW) As Variant '名前定義の参照定数を作成
     Dim Rw As Long, Col As Long
     For Rw = 1 To UBound(ListW)
         For Col = 1 To UBound(ListW, 2)
             strRefersTo = strRefersTo & IIf(Col = 1, ";", ",") & ListW(Rw, Col)
         Next Col
     Next Rw
         strRefersTo = Replace(strRefersTo, ";", "={", 1, 1) & "}"
 End Function

(半平太) 2017/06/25(日) 23:40


 すみませんでした!!
 6/23に頂いた回答を読んで、マクロ方式にするかどうするか悩んでおりました。
 その後新しい方法をご提案頂いていた事に気づかず時間が経ってしまい申し訳ございません。
 シフト表で希望休(コード808)の場合、その従業員の列に色をつける条件付き書式ですが、
 公休日(コード801)、有給(コード802)の時も色をつけようと
 「=OR(INDIRECT(ADDRESS(INT(ROW()/100)+5,COLUMN()))=801,INDIRECT(ADDRESS(INT(ROW()/100)+5,COLUMN()))=802,
 INDIRECT(ADDRESS(INT(ROW()/100)+5,COLUMN()))=808)」という条件付き書式を設定しましたが、せっかくついていた希望休の列にまで
 色がつかなくなってしまった為、どうしてだめなのか教えて頂こうとこちらを覗きましたところ、6/24以降の書き込みに気づきました。
 処理を軽くするために折角考えて頂いた重複チェックの処理を大きく変更させてしまいとても申し訳なく思います。
 新しい方法の件、まだ試しておりませんが一度試してみます。

(ぺんた) 2017/06/29(木) 16:50


 > シフト表で希望休(コード808)の場合、その従業員の列に色をつける条件付き書式ですが、
 > 公休日(コード801)、有給(コード802)の時も色をつけようと

 =OR(B$5=801,B$5=802,B$5=808)

 でいいハズですが。。

(半平太) 2017/06/29(木) 18:41


 お世話になります。
 急ぎの仕事が入ってしまい、マクロを試すのが遅くなりすみません。
 半平太さんが6/25に書き込みして頂いたマクロですが、
 以前と同じく「実行時エラー'5':プロシージャの呼び出し、または引数が不正です」とのエラーが表示され
 Earliest = Application.Min(Earliest, .FromMod)
 の所がエラーとなっています。

(ぺんた) 2017/07/14(金) 15:56


 エラーになって黄色くハイライトされた部分で、Earliest と .FromModにカーソルを近づけると、
 その値が表示されると思いますが、それぞれ、何になっていますか?

 ※私のテストでそこでStopさせると、1900/0/1、8:00:00 と出ました。

(半平太) 2017/07/14(金) 16:34


 お世話になります。
 Earliestは常に1900/01/01ですが、.FromModはアクティブにするシートによって8:15:00になったり11:00:00になったりしています。
(ぺんた) 2017/07/17(月) 09:48

 >Earliestは常に1900/01/01ですが、
 >.FromModはアクティブにするシートによって8:15:00になったり11:00:00になったりしています。

 それだと、私には、エラーが起きること自体が不思議です。
 こちらでは問題なく作動しているので、私にはどうしようもありません。

 このスレも長くなりましたので、新たに質問を立てて、他の回答者に新しいアイデアを求めてください。

(半平太) 2017/07/17(月) 15:17


 長期間お付き合い頂き、ありがとうございました。
(ぺんた) 2017/07/18(火) 13:19

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.