選択した項目は表示しないでシフト表を作成したい

質問

タイトルではわかりずらいですが、エクセルでシフト表を作成しています。

横に1日～31日、縦に作業内容（仮に15項目ほど）として、
例えば”1日の作業A”を選択するとリストでスタッフの名前が２0名出てくるとします。
そして「田中さん」を選択。次に”1日の作業B”も同じく選択するのですが、この時「田中さん」は作業Aで選択済みなので19名の中から選ぶようにしたいのです。
そして作業15項目全て選択したら5人あまりますので、作業内容の項目の下に「公休の人」として
表示させたい（できればですが…）と思ってます。

こちら　http://www.officetanaka.net/excel/function/tips/tips27.htm　　が非常に参考になったのですが、2日～31日も同様の仕組みを望んでいます。

ヒントでもなんでも結構ですので、お解かりの方是非お願いいたします。
夕方から数時間ほどしかPCができないので、お返事等は翌日になってしまうかもしれませんが
よろしくお願いします。

回答No.7

mitarashi · ベストアンサー

#1です。マクロはあまり期待されていないと思いますが、もう少し汎用性を上げたコードを投稿しておきます。
シフト表の入力する範囲に、あらかじめ「inputArea」という名前を付けておく設定とすることで、汎用性を上げたつもりです。
入力範囲の自動取得をしようとすると、一旦イベント禁止にするなど、面倒になりそうでした。
Sheet2のA列に入れた名前のリストの範囲は自動取得としてあります。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim targetRange As Range, targetColumn As Range, myCell As Range
Dim buf As Variant
Dim strList As String

Set targetRange = Range("inputArea")
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, targetRange) Is Nothing Then Exit Sub
With Sheets("Sheet2")
buf = Application.WorksheetFunction.Transpose(.Range(.Range("A1"), .Range("A" & .Rows.Count).End(xlUp)))
strList = Join(buf, ",")
End With
Set targetColumn = Intersect(targetRange, Target.EntireColumn)
strList = strList & ","
For Each myCell In targetColumn.Cells
If myCell.Value <> "" Then strList = Replace(strList, myCell.Value & ",", "")
Next myCell
strList = Left(strList, Len(strList) - 1)
With Target.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=strList
End With
End Sub

回答No.6

kagakusuki

回答番号:ANo.5です。
　申し訳御座いません。

=IF(ROW()>COUNT(AG:AG),"",INDEX($A:$A,SMALL(AG:AG,ROW())))

という数式を入力するセルのセル番号を、Sheet2のAG2セルと書きましたが、それは間違いで、正しくはSheet2のB1セルです。

回答No.5

kagakusuki

作業用Sheetを使用する方法です。
　今仮に、Sheet1のB1からAF1にかけて1日～31日と入力されていて、Sheet1のA2以下に、作業内容が入力されていて、作業内容の下に

公休の人

と入力されているものとし、Sheet2を作業用Sheetとして使用するものとします。
　まず、Sheet2のA2以下に全スタッフの名前を入力して下さい。
　次に、Sheet2のAG2セルに次の数式を入力して下さい。

=IF(OR(INDEX($A:$A,ROW())="",COUNTIF(OFFSET(Sheet1!B$1,,,MATCH("公休の人",Sheet1!$A:$A,0)-1),INDEX($A:$A,ROW()))>0),"",ROW())

　次に、Sheet2のAG2セルをコピーして、Sheet2のAH2～BK2の範囲に貼り付けて下さい。
　次に、Sheet2のAH2～BK2の範囲コピーして、同じ列の3行目以下に、スタッフの人数を上回るのに充分な行数になるまで貼り付けて下さい。
　次に、Sheet2のAG2セルに次の数式を入力して下さい。

=IF(ROW()>COUNT(AG:AG),"",INDEX($A:$A,SMALL(AG:AG,ROW())))

　次に、Sheet2のB1セルをコピーして、Sheet2のC1～AF1の範囲に貼り付けて下さい。
　次に、Sheet2のC1～AF1の範囲コピーして、同じ列の3行目以下に、スタッフの人数を上回るのに充分な行数になるまで貼り付けて下さい。

　次に、以下の操作を行って下さい。

Sheet1のB2セルを選択
　　↓
メニューの[データ]をクリック
　　↓
現れた選択肢の中にある[入力規則]をクリック
　　↓
現れた「データの入力規則」ウィンドウの「設定」タグをクリック
　　↓
「入力値の種類」欄をクリックして、現れた選択肢の中にある「リスト」をクリック
　　↓
「元の値」欄をクリックしてから、「元の値」欄に次の数式を入力する

=OFFSET(INDIRECT("Sheet2!A1"),,COLUMNS($B:B),MATCH("゛",OFFSET(INDIRECT("Sheet2!A:A"),,COLUMNS($B:B)),-1))

　　↓
「データの入力規則」ウィンドウの[OK]ボタンをクリック
　　↓
Sheet1のB2セルにカーソルを合わせて、マウスを右クリック
　　↓
現れた選択肢の中にある[コピー]をクリック
　　↓
入力規則を設定するセル範囲を選択
　　↓
選択範囲を示す黒い太枠の内側にカーソルを合わせて、マウスを右クリック
　　↓
現れた選択肢の中にある[形式を選択して貼り付け]をクリック
　　↓
現れた「形式を選択して貼り付け」ウィンドウの中にある[入力規則]と記されている箇所をクリックして、チェックを入れる
　　↓
「形式を選択して貼り付け」ウィンドウの[OK]ボタンをクリック

　次に、Sheet1において、A列で

公休の人

と入力されているセルの右隣のセルに、次の数式を入力して下さい。

=INDEX(Sheet2!B:B,ROW(1:1))
　次に、そのセルをコピーして、同じ行のC列～AF列の範囲に貼り付けて下さい。
　次に、　次に、Sheet1のA列に

公休の人

と入力されている行の、B列～AF列の範囲をコピーして、同じ列の下方に、スタッフの人数を上回るのに充分な行数だけ、貼り付けて下さい。

　以上です。

お礼

一夜にして数件の回答ありがとうございます。
直ちに勉強しながら試してみたいと思います。
私のレベルでは多少時間がかかると思いますが
数日の後ご報告させてもらいます。
本当にありがとうございました。

回答No.4

某HN クロメート(Chromate)（@CoalTar）

全5人、作業項目3つ、5日までとして

0.1 A11:A15セルに 作業員名簿

1.1 B10セルに1
1.2 右へオートフィル(すべて1)

2.1 B11セルに =ISNA(MATCH($A11,B$2:B$4,0))+B10
2.2 下へオートフィル
2.3 右へオートフィル

3.1 B5セル =INDEX($A$11:$A$15,MATCH(ROW(A1),B$10:B$14))
3.2 下へオートフィル

4.1 B7セル(5は作業員全人数)
　 =IF(5-COUNTA(B$2:B$4)<ROW(A3),"",
　　INDEX($A$11:$A$15,MATCH(ROW(A3),B$10:B$14)))
4.2 下へオートフィル

5.1 B2:B5セルを選択して 入力規則
　　リスト 元の値: =B$5:INDEX(B$5:B$9,B$15-1)

6.1 B2:B9セルを右へオートフィル

考え方としては、入力前は全員公休。
ただし、リストのためにはみ出し部分を作る(B7:B9)
そのはみ出し部分も含め入力規則で参照する

お礼

一夜にして数件の回答ありがとうございます。
直ちに勉強しながら試してみたいと思います。
私のレベルでは多少時間がかかると思いますが
数日の後ご報告させてもらいます。
本当にありがとうございました。

回答No.3

mitarashi

#2です。
#2のままでは、ところ構わず入力規則を設定してしまうので、下記コードを
>Const startRow As Long = 2 'データは2行目から設定するとする
の後ろに付け加えてください。

If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Range("A2:AF16")) Is Nothing Then Exit Sub

なお、A2:AF16のところは、実際に入力規則を設定したい範囲に変更して下さい。

回答No.2

mitarashi

Sheet1のA列にA2から作業名が入っていて、一行目にB1から行方向に日付が入っているとします。
Sheet2のA列にA1から、スタッフの名前のリストがあるとします。名前のリストの範囲に、nameListという名前をつけておきます。
動的な名前にしておくと融通が利きます（未経験でしたら参考URLをご覧下さい）
Sheet1のシートモジュールに下記コードを記述します。
思いつきでこしらえたので、お気に召したら（うまく動いたら？）幸いです。当方xl2000です。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim strList As String
Dim buf As Variant
Dim targetRange As Range, myCell As Range
Const startRow As Long = 2 'データは2行目から設定するとする

buf = Application.WorksheetFunction.Transpose(Sheets("Sheet2").Range("nameList"))
strList = Join(buf, ",")
Set targetRange = Range(Cells(startRow, 1), Cells(Rows.Count, 1).End(xlUp)).Offset(0, Target.Column - 1)
strList = strList & ","
For Each myCell In targetRange.Cells
If myCell.Value <> "" Then strList = Replace(strList, myCell.Value & ",", "")
Next myCell
strList = Left(strList, Len(strList) - 1)
With Target.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=strList
End With
End Sub

シートのイベントマクロについては下記をご参照下さい。
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_event.html

参考URL：

http://office.microsoft.com/ja-jp/excel-help/HA001126115.aspx

お礼

一夜にして数件の回答ありがとうございます。
直ちに勉強しながら試してみたいと思います。
私のレベルでは多少時間がかかると思いますが
数日の後ご報告させてもらいます。
本当にありがとうございました。

回答No.1

tom04

こんばんは！
直接の回答とはいかないと思いますが・・・
一つのヒントになれば良いと思います。

↓の画像で説明します。
Sheet2に表を作成しておきます。
A列は単に全員（20名）の名前を羅列。
B2セルに
=IF(COUNTIF(Sheet1!$B$2:$B$16,A2),"",ROW(A1))
C2セルに
=IF(ISERROR(INDEX($A$2:$A$21,SMALL(IF($B$2:$B$21<>"",ROW($A$1:$A$20)),ROW(A1)))),"",INDEX($A$2:$A$21,SMALL(IF($B$2:$B$21<>"",ROW($A$1:$A$20)),ROW(A1))))
C2セルについては配列数式になってしまいますので、この画面からSheet2のC2セルにコピー＆ペーストしてだけではちゃんと表示されないはずです。
C2セルに貼り付け後、F2キーを押す、またはC2セルをダブルクリック、または数式バー内で一度クリックし
編集可能にしたのちに、Shift＋Ctrlキーを押しながらEnterキーで確定します。
そして、B2・C2セルを範囲指定しC2セルのフィルハンドルで下へ最終行までコピー

このC2～C21セルを範囲指定し名前定義しておきます。(範囲指定後、直接名前ボックスに入力してもOKです）
仮に　リスト　と名前定義したとします。

Sheet1のB2～B16セルを範囲指定　→　データ　→　入力規則　→　リスト　→　元の値の欄に
=リスト
としてOK
これで順にリスト表示すると残ったものがリスト候補として表示されます。

A19セルには
=IF(COUNTBLANK($B$2:$B$16),"",Sheet2!C2)
という数式を入れ、5行ほどオートフィルで下へコピーしています。

これで何とか希望に近い形にならないでしょうか？

ただ・・・
リスト候補が少なくなるにつれてリスト表示の欄が空白ばかりになりますので、そこが難点かもしれません。

以上、参考になれば良いのですが
他に良い方法があればごめんなさいね。m(__)m

お礼

一夜にして数件の回答ありがとうございます。
直ちに勉強しながら試してみたいと思います。
私のレベルでは多少時間がかかると思いますが
数日の後ご報告させてもらいます。
本当にありがとうございました。