エクセルでシフト管理表を作りたく、教えてください。

質問

シート１には縦軸の所に名前が７０人くらい最初から入れてあり
横軸には日にちを３１日まで最初から書いてあり
日にちと名前が合うところにinとout時間をいれると（画像参照）

日付が合うシートの表に自動的に上に詰めて名前とinとoutが反映されるようにしたいのですが・・
できなく、困っています。
しかも９時～１１時と１２時～１５時と１６時以降と
三つに分かれてそれぞれに反映したいです。

シート２（10月１日）
　　　　９－１１　　　in　　out　　　１２－１５　　　in　　out　　１６～　　　　in　　out　
1　　　山田太郎　　9　　18　　　　　　　　　　　　　　　　　　　　斎藤四郎　17　　23
2

シートは3１日分あります。出勤時間を入れるシート（ここではシート１）そして
日にち分のシート３１枚で合計３２シートで構成されるものを考えています。

日にち（10月2日とか）のシートを見ればその日に誰が何時に出勤するかわかるようにしています。

何卒よろしくお願いいたします。

回答No.2

noname#192382 · ベストアンサー

回答1の追加です.マクロを実行しますとシート１のデータが上下に乱れますが、元に戻すには第1列のIDを使って並べ替えをすることにより戻すことが出来ます。

回答No.1

noname#192382

回答いたします。試してみてください。
シート１のB4にその月の日数を入れてください。またC4に人数を入れてください。
そこでマクロ3を実行して、それが終わったらマクロ４を実行してください、。これであなたの希望のものに近いデータが得られるはずです。

Sub Macro3()
'
' Macro3 Macro
' マクロ記録日 : 2012/11/1 ユーザー名 :
'
Dim dayno As Integer, sheetno As Integer, retuno As Integer, retuno2 As Integer, kazu As Integer, lastgyo As Integer

kazu = Cells(4, 2)

lastgyo = Cells(4, 3) + 4
For dayno = 1 To kazu
'dayno = 1
sheetno = dayno + 1
retuno = dayno * 2 + 2
retuno2 = retuno + 1
'並べ替え
Sheets("Sheet1").Select
Range(Cells(5, 1), Cells(lastgyo, 9)).Select
Selection.Sort Key1:=Cells(5, retuno), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin
'氏名コピー
Range(Cells(5, 2), Cells(lastgyo, 2)).Select
Selection.Copy
Worksheets(sheetno).Select
Cells(2, 14).Select
ActiveSheet.Paste
'データコピー
Sheets("Sheet1").Select
Range(Cells(5, retuno), Cells(lastgyo, retuno2)).Select
Application.CutCopyMode = False
Selection.Copy
Worksheets(sheetno).Select
Cells(2, 15).Select
ActiveSheet.Paste
Next
'
End Sub
Sub Macro4()
'
' Macro4 Macro
' マクロ記録日 : 2012/11/1 ユーザー名 :
'
Dim sheetno As Integer, mygyo As Integer

For sheetno = 2 To 4
Worksheets(sheetno).Select
mygyo = 2
For mygyo = 2 To 3
If Cells(mygyo, 15) <> "" Then
If Cells(mygyo, 15) < 12 Then
Cells(mygyo, 2) = Cells(mygyo, 14)
Cells(mygyo, 3) = Cells(mygyo, 15)
Cells(mygyo, 4) = Cells(mygyo, 16)
ElseIf Cells(mygyo, 15) < 16 Then
Cells(mygyo, 5) = Cells(mygyo, 14)
Cells(mygyo, 6) = Cells(mygyo, 15)
Cells(mygyo, 7) = Cells(mygyo, 16)
Else
Cells(mygyo, 8) = Cells(mygyo, 14)
Cells(mygyo, 9) = Cells(mygyo, 15)
Cells(mygyo, 10) = Cells(mygyo, 16)
End If
End If
Next
Next

'
End Sub

お礼

ありがとうございます。
今夜試してみます。
マクロ始めてなのでやってみます。
本当にありがとうございます。