予定表の組み方

質問

現在小規模の英会話スクールをやっています。
生徒は40人に届くか届かないかです。

夏休みの予定を組み終わり、これを生徒に
伝えたいのですが、問題があります。

予定表（EXCELで作成）
　　月　　火　　水　　木　　金　　土
A　青木　宮田　斉藤　田中　前田　青島
B　葛田　柴田　川田　吉田　小林　磯田
C　浅井　浅田　蔵前　細田　倉田　川本
D　・・・・
E　・・・

　　月　　火　　水　　木　　金　　土
A　石川　豊田　三木　細田　石川　川本
B　・・・・
C　・・・

全40日分つづく・・・↓

一人、一人に40日分の個々の時間割をお知らせしたいのですが、数が多すぎて簡単に伝える方法ないでしょうか？

この表を生徒に見せてしまえば自分がいつ行けばいいのかわかるのですが、個人情報や好き嫌いの時間割の差が生徒に明らかになってしまいます。

一番よいのはVBAかマクロを走らせて、ひとり一人の時間割表が書かれた用紙がプリントアウトできればよいのですが、そんなことはできるでしょうか？

詳しく説明すると、
　　7/1　　7/2　　7/3　　7/4　　7/5　　7/6
A　石川　　豊田　三木　　細田　石川　川本
B　・・・・

石川さんの個人時間割表を抽出

↓
（用紙）
石川　7/1　A、7/5　A、・・・

とうい具合で。
その用紙を石川さんに渡せば石川さんは何日に来ればよいか一目瞭然です。

別の方法でもよいのでよい方法を教えてください。

回答No.5

imogasi · ベストアンサー

例データ
2006/7/17 2006/7/18 2006/7/19 2006/7/20 2006/7/21 2006/7/22
月 火 水 木 金 土
A 青木 宮田 斉藤 田中 前田 青島
B 葛田 柴田 川田 吉田 小林 磯田
C 浅井 浅田 蔵前 細田 倉田 川本

2006/7/24 2006/7/25 2006/7/26 2006/7/27 2006/7/28 2006/7/29
月 火 水 木 金 土
A 石川 豊田 三木 細田 石川 川本
B 青木 柴田 斉藤 前田 細田 倉田
C 柴田 田中 宮田 小林 倉田 柴田

質問の例に対し、曜日行を、エクセルの正式日付に入力しなおし
する。Ｂ１セルに日付を入れて、＋ハンドルで土曜までひっぱればよい。
次の行に１行挿入し直上日付をコピー貼り付けして、その行の書式を
ユーザー定義「aaa」に設定する。
Ａ，Ｂ、ＣはＶＬＯＯＫＵＰ関数で具体的な時間帯にすることをお勧めする。
ＶＢＥの標準モジュールに
Sub test01()
k = 1
For i = 1 To 11
If IsDate(Cells(i, "B")) = True Then GoTo p01
For j = 2 To 7
For m = 1 To k
If Cells(i, j) = Cells(m, "j") Then GoTo p02
Next m
Cells(k, "J") = Cells(i, j)
k = k + 1
p02:
Next j
p01:
Next i
End Sub
を貼り付けて実行する。
するとＪ列に、生徒の一覧がでる。
青木
宮田
斉藤
田中
前田
青島
葛田
柴田
川田
吉田
小林
磯田
浅井
浅田
蔵前
細田
倉田
川本
石川
豊田
三木
ＶＢＥの標準モジュールに
Sub test02()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
sh2.Cells.Clear 'Sheet2のクリア
'---
For m = 1 To 2 '各生徒名に対して繰り返し、テスト例として２名。本番では生徒数に変更要
sh2.Cells(1, "B") = sh1.Cells(m, "J") & "殿　スケジュール表"
'---Sheet1をSheet2にコピー
sh1.Range("A1:i100").Copy
Sheets("sheet2").Activate
sh2.Range("a2").Select
ActiveSheet.PasteSpecial
'----
For i = 2 To 12 '本番では最下行番号に変更要
If IsDate(sh2.Cells(i, "B")) = True Then GoTo p01
For j = 2 To 7 'Ｂ列からＧ列までに付いて
If sh2.Cells(i, j) <> sh1.Cells(m, "J") Then '指定した生徒でなければ
sh2.Cells(i, j) = "" '氏名を消す
End If
Next j
p01:
Next i
sh2.Range("A1:H13").PrintOut 'Ａ１：Ｈ１３を印刷、本番では変更要
Next m
End Sub

を貼り付け実行する。
結果例
宮田殿　スケジュール表
2006/7/17 2006/7/18 2006/7/19 2006/7/20 2006/7/21 2006/7/22
月 火 水 木 金 土
A 宮田
B
C

2006/7/24 2006/7/25 2006/7/26 2006/7/27 2006/7/28 2006/7/29
月 火 水 木 金 土
A
B
C 宮田
仕事でエクセルを使うなら、レポート用作表などを除き、ＶＢＡは必須というのが私の持論です。

回答No.4

NCU

日付　時間　生徒
7/1　　A　　石川
7/1　　B　　・・・
7/1　　C　　・・・

既に回答されていますが、縦一列のデータベースの方が融通が利きます。

これを２次元に展開するには、例えばDGET関数とデータテーブルを組み合わせればよろしいかと思います。

回答No.3

zap35

＃０２です。もう一つ別の考え方です。
以下のマクロは１つのシートに全時間割があるとき、選択したセルの値（例えば青木）と一致しないセルの文字色を白にしてしまうというものです。４０人分繰り返せば、その生徒のみの名前が印字された予定表になります。

ただし日にちまで白色になっては困りますので「黒、自動選択以外の色に着色したセルは処理しない」仕様にしています。日にちなど消したくない部分は黒以外の適当な文字色にしておいて下さい。

Sub Macro1()
Dim cl As Range
　For Each cl In Range(Cells(1, 1), Selection.SpecialCells(xlCellTypeLastCell))
　　With cl.Font
　　　If cl = Selection.Cells(1, 1) Then
　　　　 .ColorIndex = 1
　　　Else
　　　　If .ColorIndex = 0 Or .ColorIndex = 1 Or .ColorIndex = -4105 Then
　　　　　.ColorIndex = 2
　　　　End If
　　　End If
　　End With
　Next
End Sub

条件がもっとはっきりしているなら、その条件に合わせてマクロを修正して下さい。

回答No.2

zap35

二次元の時間割を一次元に変換すれば少しは楽になるでしょう。
　　　Ａ列　Ｂ列　Ｃ列　Ｄ列　Ｅ列　Ｆ列　Ｇ列
１行目　　　月　　火　　水　　木　　金　　土
２行目　A　青木　宮田　斉藤　田中　前田　青島
３行目　B　葛田　柴田　川田　吉田　小林　磯田
４行目　C　浅井　浅田　蔵前　細田　倉田　川本

として、
Ｉ２：　=OFFSET($B$2,INT((ROW()-2)/6),MOD(ROW()-2,6))
Ｊ２：　=OFFSET($A$2,INT((ROW()-2)/6),0)
Ｋ２：　=OFFSET($B$1,0,MOD(ROW()-2,6))
とそれぞれ入力して、その関数を下にコピーして下さい

そうすれば
青木 A 月
宮田 A 火
斉藤 A 水
田中 A 木
前田 A 金
青島 A 土
葛田 B 月
柴田 B 火
のように縦に展開できます。これを５週間分行ってコピー＆ペーストすれば、全生徒の情報が縦に並びますから、あとはソートなりオートフィルタなりで加工して下さい。（曜日のところは日付にしておけばよいでしょう）

なお抽出～印刷を自動化しようと思えばやはりＶＢＡでマクロを作成する必要がありますが、そこまではここでは説明し切れません。

回答No.1

quatro100

これを簡単にやろうとするならばちょっと
VBAの知識が必要だと思われます。
逆に言えばVBAの知識があればそれ程難しいことではありません。
とはいえここで説明するには貴方のVBAに対する技術も不明ですので難しいですが・・・。
VBAの参考となるサイトは山ほどあります。
ご参考になさってください。