エクセル 複数シートにまたがるデータの抽出

質問

複数シートからのデータ抽出についていくつか拝見いたしましたが
知識が足らず、操作できませんでした。
下記のような抽出が可能であれば、ご教授いただけたらと思います。

なお、VBやマクロ等は使用したことは、ほぼありません。

シートが複数あり、またそのシートが増えていく可能性があります。
シート名→「start」「佐藤」「山本」「end」「集計1」「集計2」ととりあえず作成。
（「集計1」にて別のデータ合計をとるため、「start」「end」シートを作成しました。
　なお、佐藤～山本のシートは同じ書式ですが、シート名が変わる可能性も高い。
　今回したいのは「集計2」においてです）

「佐藤」シート

　　A　　 B　 　C　 　D
01 佐藤
02 ＼　　月曜　火曜　水曜
03 6:00　　1 　 0.5 　 1
04 7:00　　1 　　 1
05
～
18 21:00

「山本」シート

　　A　　 B　 　C　 　D
01 山本
02 ＼　　月曜　火曜　水曜
03 6:00
04 7:00　　1 　 1 　 1
05
～
18 21:00　　1 　 1 　 1

「集計2（曜日毎で、月曜）」シート

　　A　　 B　 　C　 　D
01 月曜
02
03 6:00 佐藤
04 7:00 佐藤　山本
05
～
18 21:00 山本

「集計2（曜日毎で、火曜）」シート

　　A　　 B　 　C　 　D
01 火曜
02
03 6:00 佐藤
04 7:00 山本
05
～
18 21:00 山本

できれば、名前（シート）が非常にたくさんになる可能性があるので
集計2に出てくる名前は、詰めてが理想です。
また、できればあまり都度の細かい作業がなければありがたいです。
（利用者で、できない可能性が高い）

よろしくお願い申し上げます。

回答No.2

imogasi

既に回答も出ているが、質問を一読したとき、判らなくて考えていたので
書いてみる。別の１人の意見・方法という事で上げる。
こういうエクセルでの表の組み換えは、関数では難しい。
式が長くなる。長くなるといっても、ただ長いだけでなく、その回答の式の意味を理解できる人も多くないだろう。
だからＶＢＡででも処理をしないと難しい。だだしＶＢＡの方も、質問しているレベルの人には
経験している人は少ないようで、同じことかもしれないが。
アイデアを知っている必要の在る鶴亀算と、知っておればどんな場合（問題）にでも使える
連立１次方程式で解くのとの違いを連想する。
私の持論として、エクセルを仕事の関係で使う場合は、ＶＢＡが出来ないと、
直ぐ行き詰ると思う。ＶＢＡも中級レベルぐらい出来ても、数日ぐらいは考える
・試行錯誤する必要がある場合が多いと思う。
ーー
前提
（１）個人シートと曜日シートは同一ブックにあるとする。
（２）個人シートはみな、同一フォーマットとする。
　　　曜日シートもみな、同一フォーマットとする。
（３）セル番地的に
　　個人シートは
　　　Ａ１に名前、Ｂ２：Ｈ２に曜日名
　　　Ａ３：Ａ１８に時間が有り、データはＢ３：Ｈ１８にあるとする。
　　曜日シートは
　　　Ａ１に曜日、３：Ａ１８に時間が有り、データはＢ３：○１８にあるとする。○はデータに
　　　　より列が決るということ。
（４）個人シートはシートタブ的に左に寄せ集めてあるものとする。
　　曜日シートは、シート名を月曜、火曜、・・日曜とする。
　　既に手作業で見出しなど作っておく
（５）私のやり方の場合、作業表というシートを１枚使う。既に作っておくものとする。
ーーー
例データ　　金曜日以右は略
佐藤
＼ 月曜 火曜 水曜 木曜
6:00 1 0.5 1
7:00 1 1 1
8:00 1 1 1
9:00 1 1
10:00 1 1
11:00 1 1
12:00 1
13:00 1
14:00 1
15:00 1
16:00 1
17:00
18:00
19:00
20:00
21:00
ーーーーー
金曜日以右は略
山本
＼ 月曜 火曜 水曜 木曜
6:00
7:00
8:00 1 1
9:00 1 1 1
10:00 1 1 1
11:00 1 0.5 1 1
12:00 1 1 1 1
13:00 1 1 1
14:00 1
15:00
16:00
17:00
18:00
19:00
20:00
21:00
ーーーー
コード
標準モジュールに
Sub test01()
sn = Array("", "", "月曜", "火曜", "水曜", "木曜", "金曜", "土曜", "日曜") 'シート名＝曜日名
Dim sh As Worksheet
Dim cl As Range
'--
For Each sh In Worksheets
If sh.Index <= 2 Then '個人票について,２人の例なので、タブの左から２番目までが個人表とする
MsgBox sh.Name
sh.Range("A1:F30").Copy Worksheets("作業表").Range("A1") '個人表を作業表にコピー
For Each cl In Worksheets("作業表").Range("B3:H18")
If cl.Value <> "" Then 'セルに記入があれば
cl = sh.Range("A1") '出勤時間帯を名前に置き換える
End If
Next
'----個人別データをコピーした作業表を妖美元に別表に反映。実労者氏名を左詰でＢ列以右列に順に詰めて表示
For j = 2 To 5 '本テストでは月曜日から木曜日（実際は日曜日まで　To 8 にする）
MsgBox sn(j)
For i = 3 To 18 '3行目から１８行目まで
If Worksheets("作業表").Cells(i, j) <> "" Then
c = Worksheets(sn(j)).Cells(i, 20).End(xlToLeft).Column 'その時間で記入済みの最右列を探す
Worksheets(sn(j)).Cells(i, c + 1) = Worksheets("作業表").Range("A1") '勤務者名をセット
End If
Next i
Next j
End If
Next
End Sub
ーーーーーーーー
実行した結果
月曜

6:00 佐藤
7:00 佐藤
8:00 佐藤 山本
9:00 佐藤 山本
10:00 佐藤 山本
11:00 佐藤 山本
12:00 山本
13:00 山本
14:00
15:00
ーーーーー
火曜

6:00 佐藤
7:00 佐藤
8:00 佐藤
9:00
10:00
11:00 山本
12:00 山本
13:00 山本
14:00
15:00
ーーーーー
水曜

6:00 佐藤
7:00 佐藤
8:00 佐藤 山本
9:00 佐藤 山本
10:00 佐藤 山本
11:00 山本
12:00 山本
13:00
14:00
15:00
ーーーーーーーーー
木曜
6:00
7:00
8:00
9:00
10:00 山本
11:00 山本
12:00 佐藤 山本
13:00 佐藤 山本
14:00 佐藤 山本
15:00 佐藤 山本
16:00 佐藤
17:00 佐藤
18:00
19:00
ーーーーーーーーーーー
こういう風な表で良いのかな。
名づけるなら「時間帯別勤務社名一覧」といったものになっている。
こんな様子で良いのかな。
質問では集計表とあるが、数（時間？）データを足したいのかな。
個人票のデータセルで、０．５（３０分？）という例が見えるが、上記では１と同じになっている。
迷いはあった。
また１週間分になっているが、週次作業で良いのかな。月次作業だとプログラムを
相当変更しないとならない。
実際に使えるようにするにはコードの修正が必要なので
絶望的だが、参考に。

回答No.1

tom04

こんにちは！

ご希望の関数ではなく、VBAでの方法になってしまいますが・・・

Sheet名に関係なく↓の画像のようなSheet順になっている場合での一例です。
※　Sheet1～Sheet7までが各曜日のSheetでSheet8から個人用Sheetとしています。
（画像が小さくて見えにくかったらごめんなさい。）

Alt+F11キー　→　画面左下にある「This Workbook」をダブルクリック　→　VBE画面が出ますので
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt+F8キー　→　マクロ　→　マクロ実行です。）

Sub test() 'この行から
Dim i, j, k, L As Long
Application.ScreenUpdating = False
For k = 1 To 7 'Sheet1～Sheet7（月曜～日曜）
Range(Worksheets(k).Columns(2), Worksheets(k).Columns(256)).ClearContents
Next k
For k = 1 To 7
For L = 8 To Worksheets.Count '各個人名Sheet数分
For i = 3 To 18 '3行目～18行目
For j = 2 To 8 '2列目～8列目（月曜～日曜の列）
If Worksheets(L).Cells(2, j) = Worksheets(k).Cells(1, 1) Then
If Worksheets(L).Cells(i, j) <> "" Then
Worksheets(k).Cells(i, Columns.Count).End(xlToLeft).Offset(, 1) _
= Worksheets(L).Cells(1, 1)
End If
End If
Next j
Next i
Next L
Next k
Application.ScreenUpdating = True
End Sub 'この行まで

こんな感じではどうでしょうか？
他に良い方法があればごめんなさいね。m（_ _）m

お礼

とてもわかりやすい説明、ありがとうございます！

教えていただいた内容で、うまくいきました♪
画像もつけてくださったので、シートの並びも
自分の作成とは違ったのですが
初心者に近いので…理解しやすかったです。
お心遣いに感謝いたします。

何分〆切が差し迫っていたため、本当に本当に助かりましたm(__)m

これを機会に、VBAも学んでいけたらと思っています。