エクセルで、勤務表から 日付別に勤務者と勤務形態を抽出して、別シートに抽出したい

質問

Ｓｈｅｅｔ 1 勤務表（４月）
　 　 A　　　　 B　　　　　C　 　　　　D…
　　　　　 　 4/1 　　 　 4/2 　　　4/3 …

１　赤星 　　　 早１　　　　夜勤入り　　夜勤明け　…
２　関本　　　　遅１　　　　早１　　　　早１　　　…
３　新井　　　　休　　　　　遅１　　　　早２　　　…
４　金本　　　　夜勤入り　　夜勤明け　　休　　　　…
５　ブラぜル　　夜勤明け 休　　　　　遅１　　　…
６　桜井　　　　休　　　　　早２　　　　遅２　　　…
７　鳥谷　　　　早２　　　　遅２　　　　早３　　　…
８　狩野　　　　遅２　　　　早３　　　　休　　　　…
９　藤川　　　　早３　　　　休　　　　　夜勤入り　…

以上のような、勤務表、（各列には、日付、各行には、従業員の名前が９人）が、あり、毎日、早番 3種類、遅番 2種類、夜勤入り 1人、夜勤明け 2人、休み、のデータが入っています。（ずれていたら、すいません）
これを、Ｓｈｅｅｔ ２以降に、日付ごとに、出勤している従業員名と、そのとなりのセルに、その従業員の勤務種別を抽出して、表示したいのです。しかも、夜勤入り、夜勤明け、休みは表示させたくありません。）例えば、こんな感じです。

Ｓｈｅｅｔ ２　　　Ｓｈｅｅｔ ３　　 　Ｓｈｅｅｔ 4
（４月１日）　　　　（４月2日）　　 　（４月3日）
赤星 早１　　　　　関本　早１　 関本　　早１
関本　遅１　　　　　新井　遅１　 新井　　早２
鳥谷　早２　　　　　桜井　早２　　 ブラぜル 遅１
狩野　遅２　　　　　鳥谷　遅２　　 桜井　　遅２
藤川　早３　　　　　狩野　早３　　　 鳥谷　　早３　

いろいろとムシのいい話を書いて申し訳ありませんが、当方vbaの初心者で、このような場合、何から手を付けて良いのか分からず、困っております。どうか、なにとぞ、ご教授下さい。

回答No.5

KURUMITO · ベストアンサー

回答Ｎｏ3です。
ごめんなさい。肝心の式の表示が抜けておりました。
Ａ15セルには次の式を入力し、下方にオートフィルドラッグします。
=ROW(A3)
Ｂ15セルには次の式を入力し右方向にオートフィルドラッグしたのちに下方向にもオートフィルドラッグします。
=IF((IF(B3="早1",1,0)+IF(B3="早2",1,0)+IF(B3="早3",1,0)+IF(B3="遅1",1,0)+IF(B3="遅2",1,0))=0,"",MAX(B$14:B14)+1)

回答No.6

end-u

勤務表が正確に提示のレイアウトのみだったら、
[複数のワークシート範囲]からの[ピボットテーブル]をつくって
値フィールドを行フィールドに追加し、列フィールドをページフィールドに移動させて
[ページの表示]で各シートに分割作成する事ができます。
つまり勤務表を完成させた後に一気に手作業でできるというわけです。

が、実際は社員コードなどがあったりしてそんなに上手い事いかないと思いますので、まあ参考程度に。
#あまり深追いするつもりもないので上手くいかなくてもサラっと流しておいてください：D

Sub test()
　　Dim r　As Range
　　Dim ri As Range
　　Dim i　As Long

　　With ActiveWorkbook
　　　　With .ActiveSheet
　　　　　　.Move before:=.Parent.Sheets(1)
　　　　　　Set r = .Range("A1").CurrentRegion
　　　　End With
　　　　Set ri = r.Offset(r.Rows.Count + 10).Item(1)
　　　　With .PivotCaches.Add(SourceType:=xlConsolidation, _
　　　　　　　　　　　　　　　SourceData:=r.Address(1, 1, xlR1C1, True)) _
　　　　　　　　　　　　　　　.CreatePivotTable(TableDestination:=ri)
　　　　　　.AddFields RowFields:=Array("行", "値"), PageFields:="列"
　　　　　　.PivotFields("行").Subtotals(1) = False
　　　　　　.ColumnGrand = False
　　　　　　With .PivotFields("値")
　　　　　　　　.PivotItems("休").Visible = False
　　　　　　　　.PivotItems("夜勤入り").Visible = False
　　　　　　　　.PivotItems("夜勤明け").Visible = False
　　　　　　End With
　　　　　　.ShowPages PageField:="列"
　　　　　　.TableRange2.Clear
　　　　End With
　　　　For i = 1 To r.Worksheet.Index - 1
　　　　　　With .Worksheets(i).UsedRange
　　　　　　　　.Copy
　　　　　　　　.PasteSpecial xlPasteValues
　　　　　　　　.Columns(3).Delete
　　　　　　　　.Rows("2:4").Delete
　　　　　　End With
　　　　Next
　　End With

　　Set ri = Nothing
　　Set r = Nothing
End Sub

回答No.4

_Kyle

課題自体は単なる転記マクロなんですが、
「月初に（ワークシートの作成も含め）一括して処理する」のか
「元データの追記・変更にともなって随時更新する」のか
によって話が違ってきますし、
シート名や、元範囲、書出範囲の位置等具体的なことがわからないので、
…とりあえずユーザー定義関数にしてみました。(^^;;;
---------------------------------------------------------
■Sample(【元範囲】,【日付】)

例えば、参考画像のように
　・元範囲が　Sheet1のA1:AE10　である
　・Sheet2のA1セルに　日付　4/1　が入力されている
場合、

Sheet2のA2:B10セルを選択して、
　=sample(Sheet1!A1:AE10,A1)
と入力し、[Ctrl]+[Shift]+[Enter]で確定すれば、ご要望の結果が返ります。
※結果が配列で返ってくるので、配列数式として確定する必要があります。

後は、Sheet2を必要なだけコピーして、
A1セルの日付をそれぞれ変更すれば当座の用には足りるかと。

'==========================↓　ココカラ　↓==========================
Function Sample(ByVal myRng As Range, ByVal clKey As Variant) As Variant

　Dim orAry　 As Variant
　Dim clIdx　 As Long
　Dim rtAry() As String
　Dim exAry　 As Variant
　Dim i　　　 As Long
　Dim j　　　 As Long
　Dim k　　　 As Long
　Dim f　　　 As Boolean

　orAry = myRng.Value
　clIdx = Application.Match(clKey, myRng.Rows(1), 0)
　exAry = Array("休", "夜勤明け", "夜勤入り")

　ReDim rtAry(1 To myRng.Rows.Count, 1 To 2)
　k = 0
　For i = 2 To UBound(orAry, 1)
　　f = True
　　For j = 0 To UBound(exAry)
　　　f = f And (orAry(i, clIdx) <> exAry(j))
　　Next j
　　If f Then
　　　k = k + 1
　　　rtAry(k, 1) = orAry(i, 1)
　　　rtAry(k, 2) = orAry(i, clIdx)
　　End If
　Next i

　Sample = rtAry
End Function
'==========================↑　ココマデ　↑==========================

以上ご参考まで。

お礼

ご回答ありがとうございます。おっしゃるように、具体的な設定があいまいな部分は、実は、私自身、どのように、この業務分担表をレイアウトするのか？整理できてないまま、質問してしまい、それを、丁寧に答えてくださり、ありがとうございます。画像まで貼っていただき、とても初心者の私にとって、ありがたかったです。本当にありがとうございました。

回答No.3

KURUMITO

マクロでのほうが簡単なことでしょうが関数で処理する方法を考えていましたのでご参考までに。
シート1では1行目に日付があり3行目からデータがあるとします。
作業用として
Ａ15セルには次の式を入力し下方にオートフィルドラッグします。
Ｂ15セルには次の式を入力し、横方向に30列以上オートフィルドラッグし下方にもオートフィルドラッグします。
ここで表示されるデータをもとに別のシートへのデータ入力に使用します。
次にシート見出しでSheet2から例えばSheet32までを並べて置きSheet2選択したのちにSheet32をＳｈｉｆｔキーを押しながらクリックします。これでシート2からシート32までが同じ作業グループになります。
この状態でシート2のＡ1セルには4/1と入力します。4月1日のデータを表示するためのシートになります。
次にＡ3セルには次の式を入力し、Ｂ3セルまでオートフィルドラッグしたのちに下方にもオートフィルドラッグします。
=IF(OR($A$1="",COUNTIF(Sheet1!$1:$1,$A$1)=0),"",IF(COUNTIF(INDEX(Sheet1!$A:$AE,1,MATCH($A$1,Sheet1!$1:$1,0)):INDEX(Sheet1!$A:$AE,100,MATCH($A$1,Sheet1!$1:$1,0)),ROW(A1))=0,"",INDEX(Sheet1!$A:$AE,INDIRECT("Sheet1!A"&MATCH(ROW(A1),INDEX(Sheet1!$A:$AE,1,MATCH($A$1,Sheet1!$1:$1,0)):INDEX(Sheet1!$A:$AE,100,MATCH($A$1,Sheet1!$1:$1,0)),0)),IF(COLUMN(A1)=1,1,MATCH($A$1,Sheet1!$1:$1,0)))))
この入力済んだ後でシート見出しで右クリックし「作業グループ解除」を選択します。
各シートには4月1日のデータが表示されていることでしょうが、各シートでＡ1セルの日付を変えることでその日のデータが表示されますし、Ａ1セルを空にすればデータは表示されません。

お礼

ご回答ありがとうございます。こちらも、初心者にわかりやすいように、関数で処理していただいたのですね。

正直申しまして、ご回答いただいた、１１行目の関数は、今の自分のレベルでは、理解しがたい複雑な長い関数（涙…）で、どうやったら、こんな関数を思いつくのか？すごいなぁ、と思って、唸ってしまいます。

ところで、稚拙な質問ですが、この１１行目の関数（Ａ3セルに入力する関数）は、作業用としての、Ａ15,Ｂ15セルにも入力して良いのでしょうか？

回答No.2

imogasi

ＶＢＡで回答をほしいなら、表題の何処かか、質問文の始めに明記すること。答える層も変わってくる。
ＶＢＡに関してぐらいになると、丸投げ質問は、当コーナーの質問規約違反です。
＝＝＝
１．Ｓｈｅｅｔ１のデータの最終行を捉えるコードは知っているか。
２．Ｓｈｅｅｔ１の第初のデータ行から、１の最終行まで下記を繰り返す
３．シートへ振り分ける
　日付でシートを別にするらしいから、
　　　日付ー＞シート名
　　の対応（割り出し）をどうするか考える。
　　ＩＦ文では月中日数分聞くのは煩雑だろうから、
　　前もって日付の月中日数分のシートを作っておくか、と言う仕方も有る。日付はヒヅケシリアル値、シート名は文字列なので変換が必要だがわかるかな。
　　日付からシート名の対応を割り出すのはどうするか？
４．シート名が割り出せれば、そのシートの書き込み前の
最終行の次の行に、今のＳｈｅｅｔ１の考えている行のデータを転記（注）（代入）すればよい。＞夜勤入り、夜勤明け、休みは表示させたくありません、はデータを持ってこなければよいのかな。持ってきても列
非表示などどうすると言うのかな。
（注）転記とは、（左辺）当日付と対応したシート。最終行の次、列＝（右辺）Ｓｈｅｅｔ１の今考えている行、列のセルのデータ
のコード。
＝＝
上記文章を、よく読んで、１、３，４で私が言っていること、コード化の方法が、判から無い点は補足の事。

お礼

ご回答ありがとうございます。ご推察のように、当方、vbaの入門本を読破した程度で、いろいろと分からない事がいっぱいで、手探り状態なので、今現在、一つずつ、覚えている状態です。ご指摘の点を参考に自分なりに考え、さらにレベルアップしていきたいです。このような、レベルの低い質問に、懇切丁寧に答えて頂き、また、叱咤激励をして頂きまして、ありがとうございました。

回答No.1

tom04

こんばんは！
結論として、「休」・「夜勤入り」・「夜勤明け」　を表示しなければ良い訳ですよね？
参考になるかどうか分かりませんが・・・

一例として

↓の画像のように表を作ってみました。
（別Sheetにしていませんので、数式はアレンジしてみてくださいね）

作業のための表を使う方法ですので、ちょっと手間がかかるかもしれません。
それから表示させたいセルが氏名と勤務状況が交互のセルになっていますので、
列方向へのオートフィルは出来ません。（行方向のオートフィルは出来ます）

したがって、日付毎に数式を入れてやる方法になりますが、

まず、作業用の表の
B14セル　=IF(OR(B2=$A$13,B2=$A$14,B2=$A$15),"",ROW(A1))
として、列・行方向にオートフィルでコピーしています。

F2セル　=IF(COUNT($B$14:$B$22)>=ROW()-1,INDEX($A$2:$A$10,SMALL($B$14:$B$22,ROW()-1)),"")
H2セル　=IF(COUNT($C$14:$C$22)>=ROW()-1,INDEX($A$2:$A$10,SMALL($C$14:$C$22,ROW()-1)),"")
J2セル　=IF(COUNT($D$14:$D$22)>=ROW()-1,INDEX($A$2:$A$10,SMALL($D$14:$D$22,ROW()-1)),"")

G2セル　=IF(F2="","",VLOOKUP(F2,$A$2:$D$10,2,0))
I2セル　=IF(H2="","",VLOOKUP(H2,$A$2:$D$10,3,0))
K2セル　=IF(J2="","",VLOOKUP(J2,$A$2:$D$10,4,0))

として、F2～K2セルを範囲指定した後に
オートフィルで下へコピーしています。

ただし、この操作を日数分だけ繰り返さないといけなくなりますので、
かなり厄介ですよね・・・

表の配置を考えればもっと簡単に出来るかもしれませんが、
今は良い案が思い浮かびません。

この程度の回答しか出来ませんが、
他に良い方法があったり、的外れの回答なら
読み流してくださいね。m(__)m

お礼

早速のご回答ありがとうございます。関数を使っての処理ですね。おっしゃるように、完全解決とはいかないかもしれませんが、逆に手軽に作成できそうで、当方、vbaしか、頭になかったものですから、このアプローチ法に目から鱗でした。画像まで貼り付けて頂き、懇切丁寧にありがとう、ございます。ちなみに、tom04さんは、広島ファンですね。今年は、新球場効果にはじまり、広島野球がおもしろいですね