Excelで月間予定表を作成したのですが。。。困っています(>_<)

質問

ヘルパーさんの月間予定表を作成しました。
全体予定表シートにすべての予定を入力し、
別シートで担当者別、もしくは同一シートで担当者別に予定表を表示できないものかと。。
担当者別で配布が必要なため。。。

全体予定表シートの作りは、
カレンダータイプ(日始まり土曜日)で、
A5～C5(結合セル)→曜日(日曜日)
A7～C7(結合セル)→日付(1日)
A8～A20行先(リスト選択・別のマスタシート参照)　
B8～B20→時間(手入力)
C8～C20→担当(リスト選択・別のマスタシート参照)
↑上記が1日分とみなし、予定が12回分まで入力できる形で作成し、横に7日分、下に5日分　合計35日分で1ヶ月分の月間予定表です。

何か方法があれば、教えてください。
よろしくお願いいたしますm(__)。

回答No.3

char0078 · ベストアンサー

ピボットテーブルを使えば担当者別や行き先別などの表がとても簡単にできますが、そのためには元データの表をリストの形に作り直さなければなりません。

元の月間予定表のシート名を「予定表」とします。

別シートに、
A1：曜日
B1：日付
C1：行き先
D1：時間
E1：担当者
として、

A2～A14に　=予定表!$A$5　（全部同じ式を入れる）
B2～B14に　=予定表!$A$7　（全部同じ式を入れる）
C2～C14に　=予定表!A8　～　=予定表!A20
D2～D14に　=予定表!B8　～　=予定表!B20
E2～E14に　=予定表!C8　～　=予定表!C20

のように、2行目から14行目を1日分とします。

同様に15行目から27行目を2日分として、35日分の縦長の表を作って、予定表の記入内容が反映されるようにしておきます。
（この表はデータベース用なので体裁は適当でいいです）

この表を元データとしてピボットテーブルを作ります。

データ　→　ピボットテーブルとピボットグラフレポート　を選択すると、ウイザードが立ち上がりますので、後は指示の通りに進んでいけば出来上がります。

担当者別など色々な表が出力できて便利です。

ただ、ピボットテーブルは、元データの作り方で全て決まってしまいます。
元データに空白行があったりするとうまく行きませんので、ピボットテーブル作成前に空白行を削除しておいてください。
あと、ピボットテーブルは自動再計算を行わない仕様になっていますので、データを変更した場合にはピボットテーブルの更新を忘れないようにしてください。

参考URL：

http://hp.vector.co.jp/authors/VA014071/tips/xl_pvt1.html

お礼

お礼が遅くなり申し訳ありませんでした。
無事解決できましたので、お礼申し上げます。
ありがとうございました。

補足

char0078様。
ご回答ありがとうございます。
ピポットテーブルですね！！
マクロは実行ボタンを押すのと、いらない部分を削除することしかやったことがなかったのですが、
ピポットテーブルなら！うんうん。ちょっと希望が沸いてきました。
入力するシートを“予定表”として、
反映シートをカレンダーフォームで、管理者用(全体)と担当者別でできるように、早速やってみます。また分からないことがあれば、教えていただければ幸いです。よろしくお願い致します。

回答No.2

pascal3141

マスターシートを"main"
プリントシートを"print"とします。

"print"シートのB1に担当者の名前をいれておきます。
後は、「ツール」「マクロ」「Visual Basic Editor」で「挿入」「標準モジュール」のあと、ダイアログ画面上に次のコードを入力orペーストしてください。
後は、「マクロ」「実行」で"print"シートに担当分が出てきます。

注意：(1)書いてあるセル番地を元に作ったのですが、もしずれていればいけませんので、必ずコピーをとったもので確かめてください。

(2)また"print"シートの担当者を入れる場所は、どのセルでもいいですが、変更したら、コードの'担当別検索
Tantou = WS2.Cells(2, 1).Value　の部分のceiis(2,1)の数字を変えてください。2-行、1-列を表しています。
(3)シートの名前もSet WS1 = Worksheets("main")
Set WS2 = Worksheets("print")の名前を変えればいいです。
(4)空白が多いですが、担当がわかればいいのであればこれでいけるかと？
----------------------------------
Sub Tantou()
Dim i, j, k As Integer
Dim WS1, WS2 As Object
Dim p, q, r As Integer
Dim Tantou As String

p = 13
q = 7
r = 5

Set WS1 = Worksheets("main")
Set WS2 = Worksheets("print")

Application.ScreenUpdating = False

With WS2
'print シートデータ消去
WS2.Range("A8:U20").Select
Selection.ClearContents
WS2.Range("A24:U36").Select
Selection.ClearContents
WS2.Range("A40:U52").Select
Selection.ClearContents
WS2.Range("A56:U68").Select
Selection.ClearContents
WS2.Range("A72:U84").Select
Selection.ClearContents
WS2.Range("A1").Select

'担当別検索
Tantou = WS2.Cells(2, 1).Value
If Tantou = "" Then Exit Sub
For k = 1 To r
For j = 1 To q
For i = 1 To p
If WS1.Cells(k * 16 + i - 9, j * 3).Value = Tantou Then
WS2.Cells(k * 16 + i - 9, j * 3).Value = Tantou
WS2.Cells(k * 16 + i - 9, j * 3 - 1).Value = WS1.Cells(k * 16 + i - 9, j * 3 - 1).Value
WS2.Cells(k * 16 + i - 9, j * 3 - 2).Value = WS1.Cells(k * 16 + i - 9, j * 3 - 2).Value
End If
Next i
Next j
Next k
End With
End Sub

お礼

お礼が遅くなって申し訳ありませんでした。
今回は、ＮＯ.３の方の方法で解決できました。
ありがとうございました。

補足

pascal3141さん、丁寧なご回答ありがとうございます。
教えていただいた通りに、シートの名前も変更し、ヘルパー名もprintシートのB1に入力し、行ってみたのですが、
>Set WS1 = Worksheets("main")この段階で実行時エラーが発生してしまいます(>_<)
何がいけないのでしょうか？？

回答No.1

harukabcde

逆転の発想

各担当者別に入力し、
管理する表に一覧表示されるようにする。

お礼

ご回答ありがとうございます。
当初、各自のシートで作成して行ったのですができず、逆転の発想をしたつもりでいけない方向へ行ってしまったのでしょうか？再度検討させてもらいます。