はじめに
名簿リストから席を自動で決定してくれる Excel マクロの作り方についてご紹介します。
このマクロは席数を自分で指定できるようにしてあるので、例えば 4 × 4 や ５× 6 の席でも自由に変えて席替えできることができます。
小学校や中学、高校では、気分転換のためかなんとなくか目的はさまざまですが、とにかく定期的に席替えが行われると思います。
そんなとき毎回くじ作ってそのくじを引いてみんなでギャーギャー騒いで...って楽しいんですが、教員の方は早く帰りたいのかもしれません。
そんな教師はあんまり見たことがないんですが、少なからず席替えに時間を割くことがほとんどなくなりますので「いいな」と思われた人はぜひ使ってみてください。
※実際に作成した Excel マクロは下記のボタンからダウンロードできます。
操作方法
（１）名前を入力します。名前の左に番号が付いていますが、番号はなんでもいいです。
ダウンロードしたマクロには番号を自動で入力する関数を埋め込んでいますが、消して出席番号とかにしていただいても問題ありません。
（２）席の行数と列数を入力します。値は整数を入力してください。また「チェック」というセルで入力チェックを行ってます。
例えば、名簿シートに１０人で座席数が６（行数 : 2 列数 : 3）の場合は、４人分席が不足していますね。こういうときは「チェック」欄に座席数が不足しています。というメッセージが表示されます。
（３）「座席表を作成」ボタンを押下します。すると別シート「座席表」に結果が表示されます。
座席表自動作成マクロの作り方
座席表自動生成マクロの作成方法についてご紹介します。今回は Excel vba をつかって作成しています。
- 「名簿」シート : 名簿を入力するシート
- 「座席表」シート : 座席表が出力されるシート
シートは上記２種類から構成されます。要は入力用シートとして「名簿」、出力用シートとして「座席表」の２種類です。
「名簿」シート
入力欄は「名前」「行数」「列数」の三つです。
「番号」はいちおうつけていますが、処理上は何の関係もありません。つまりどんな番号が入力されても問題なく動作できます。
ダウンロード用の Excel マクロは自動で入力できるようにしていますが、上書きして出席番号にしていただいても何の問題ありません。
「座席表」シート
初期はまっさらなシートです。処理が完了した後に座席表が書き出されます。
処理内容（Excel vba）
- 名簿シートの読み込み
- 座席表シートへの書き込み
- 教卓の書き込み
名簿シートの読み込み
これはシンプルな処理で、「名簿」シートのB列２行目からセルの値が空白になるまで読み込んで配列に入力しているだけです。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 |
'名簿シートの読み込み Private Sub readNameList(ByRef NameList() As String) Const x As Integer = 2 Const y As Integer = 3 Dim Name As String Dim index As Integer: index = 0 Do ReDim Preserve NameList(index) Name = Worksheets(NAMELISTSHEET).Cells(y + index, x).Value NameList(index) = Name index = index + 1 Loop Until Name = "" If UBound(NameList) = 0 Then MsgBox "名前を入力してください" End End If ReDim Preserve NameList(UBound(NameList) - 1) End Sub |
座席表シートへの書き込み
「名簿」シートから取得した名前のデータを含む配列をランダムに取り出して、取り出した値を「座席表」シートに書き込むだけの処理です。
ソースコードを見ると複雑そうに見えますがやっていることはシンプルです。
- 「名簿」シートのエラー処理（座数の行数と列数 : 数値以外 or 0のとき or 空白ならエラー)
- エラー処理が終わったら「座席表」シートをいったん初期化
- 「名簿」シートから取得した名前を「座席表」シートに書き込む
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 |
' 座席シート表への書き込み Private Sub writeZasekihyo(ByRef NameList() As String) Const x As Integer = 2 Const y As Integer = 4 Dim RandList() As Integer Dim Name As String Dim i, j, k j = 0 k = 0 Dim Max_Row Dim Max_Column Max_Row = Worksheets(NAMELISTSHEET).Cells(2, 4).Value Max_Column = Worksheets(NAMELISTSHEET).Cells(2, 5).Value If Max_Row = "" Or Max_Column = "" Then MsgBox "行と列を入力してください" End End If If Max_Row < 1 Or Max_Column < 1 _ Or IsNumeric(Max_Row) = False Or IsNumeric(Max_Column) = False Then MsgBox "行と列には 1 以上の数値を入力してください" End End If ' 乱数作成 Call calRandomArray(RandList, UBound(NameList) + 1) ' 初期化 Application.ScreenUpdating = False Call defaultSetting(x, y - 2, Max_Row) ' 座席表へ書き込み For i = 0 To Max_Row * Max_Column - 1 If i <= UBound(RandList) Then Name = NameList(RandList(i)) Else Name = "" End If Call writeZasekihyo_oneChair(k + x, j + y, Name) If k = Max_Column - 1 Then k = 0 j = j + 1 If j = Max_Row Then Exit For End If Else k = k + 1 End If Next i Application.ScreenUpdating = True End Sub ' 乱数生成 Sub calRandomArray(ByRef arr() As Integer, ByVal MAX_NUM As Integer) Dim i, rand As Integer Dim num() As Boolean ReDim num(MAX_NUM) ReDim arr(MAX_NUM) Randomize For i = 0 To MAX_NUM - 1 Do rand = Int(Rnd() * MAX_NUM) Loop Until num(rand) = False arr(i) = rand num(rand) = True Next i ReDim Preserve arr(UBound(arr) - 1) End Sub ' 初期化 Private Sub defaultSetting(ByVal x As Integer, ByVal y As Integer, ByVal Max_Row As Integer) Worksheets(ZASEKISHEET).Select With Worksheets(ZASEKISHEET).Range(Cells(y, x), Cells(y + 100, x + Max_Row + 100)) .ClearContents .Borders.LineStyle = xlLineStyleNone End With Worksheets(ZASEKISHEET).Rows("2:2").Select Selection.Delete Shift:=xlUp Worksheets(ZASEKISHEET).Range("A1").Select End Sub ' 座席のセルの書式 Private Sub writeZasekihyo_oneChair(ByVal x As Integer, ByVal y As Integer, ByVal Name As String) With Worksheets(ZASEKISHEET).Cells(y, x) .Value = Name .Borders.LineStyle = xlContinuous .RowHeight = 50 .ColumnWidth = 20 .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .Font.Size = 20 End With End Sub |
教卓の書き込み
最後に教卓を書き込む処理です。２行目に固定で、列は座席表の列数の値に応じて書き込まれます。
席の列数を2で割ったときの剰余計算（余りを算出）をして、その値が1の場合（つまり奇数のとき）は、席の列数を２で割った値を整数に変換し、得られた値 + 2を書き込み先の列番号とします。
席の列数を剰余計算をした値が0の場合（つまり偶数のとき）、席の列数を２で割った値を整数に変換し、得られた値 + 1 と得られた値 + 2 を書き込み先の列番号（事前に二つのセルを結合させるように処理）とします。
例えば席の列数が７（奇数）の場合、7 ÷ 2 = 3.5 を整数にして 3にします。そして 3 + 2 = 5 列目のセルに書き込むようにします。
また席の列数が８（偶数）の場合、8 ÷ 2 = 4とし、4 + 1 = 5 列目と 4 + 2 = 6 列目を書き込み先の列番号とします。
最後の + 2 ですが、これはB列（つまりセルの２列目）から座席表を書き込むように処理するためにつけています。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 |
' 教卓を描く Private Sub writeKyotaku() Const x As Integer = 2 Const y As Integer = 4 Dim kyotaku As Integer Dim Max_Column As Integer Max_Column = Worksheets(NAMELISTSHEET).Cells(2, 5).Value kyotaku = Int(Max_Column / 2) If Int(Max_Column / 2) = 0 Then kyotaku = 0 With Worksheets(ZASEKISHEET).Cells(2, kyotaku + x) .Value = "教卓" .Borders.LineStyle = xlContinuous .RowHeight = 50 .ColumnWidth = 20 .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .Font.Size = 20 End With Else If Max_Column Mod 2 = 1 Then kyotaku = Int(Max_Column / 2) With Worksheets(ZASEKISHEET).Cells(2, kyotaku + x) .Value = "教卓" .Borders.LineStyle = xlContinuous .RowHeight = 50 .ColumnWidth = 20 .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .Font.Size = 20 End With Else kyotaku = Int(Max_Column / 2) - 1 With Worksheets(ZASEKISHEET).Range(Cells(2, kyotaku + x), Cells(2, kyotaku + x + 1)) .Merge .Value = "教卓" .Borders.LineStyle = xlContinuous .RowHeight = 50 .ColumnWidth = 20 .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .Font.Size = 20 End With End If End If End Sub |
まとめ
いかがでしょうか？
かなりざっくりした説明だったかもしれませんので、もし作るのがめんどくさいと感じた方は下記ボタンからダウンロードしてみてください。
