名簿リストから席を自動で決定してくれる Excel マクロの作り方についてご紹介します。

このマクロは席数を自分で指定できるようにしてあるので、例えば 4 × 4 や ５× 6 の席でも自由に変えて席替えできることができます。

小学校や中学、高校では、気分転換のためかなんとなくか目的はさまざまですが、とにかく定期的に席替えが行われると思います。

そんなとき毎回くじ作ってそのくじを引いてみんなでギャーギャー騒いで...って楽しいんですが、教員の方は早く帰りたいのかもしれません。

そんな教師はあんまり見たことがないんですが、少なからず席替えに時間を割くことがほとんどなくなりますので「いいな」と思われた人はぜひ使ってみてください。

※実際に作成した Excel マクロは下記のボタンからダウンロードできます。

操作方法

（１）名前を入力します。名前の左に番号が付いていますが、番号はなんでもいいです。

ダウンロードしたマクロには番号を自動で入力する関数を埋め込んでいますが、消して出席番号とかにしていただいても問題ありません。

（２）席の行数と列数を入力します。値は整数を入力してください。また「チェック」というセルで入力チェックを行ってます。

例えば、名簿シートに１０人で座席数が６（行数 : 2  列数 : 3）の場合は、４人分席が不足していますね。こういうときは「チェック」欄に座席数が不足しています。というメッセージが表示されます。

（３）「座席表を作成」ボタンを押下します。すると別シート「座席表」に結果が表示されます。

座席表自動作成マクロの作り方

座席表自動生成マクロの作成方法についてご紹介します。今回は Excel vba をつかって作成しています。

シートは上記２種類から構成されます。要は入力用シートとして「名簿」、出力用シートとして「座席表」の２種類です。

「名簿」シート

入力欄は「名前」「行数」「列数」の三つです。

「番号」はいちおうつけていますが、処理上は何の関係もありません。つまりどんな番号が入力されても問題なく動作できます。

ダウンロード用の Excel マクロは自動で入力できるようにしていますが、上書きして出席番号にしていただいても何の問題ありません。

「座席表」シート

初期はまっさらなシートです。処理が完了した後に座席表が書き出されます。

処理内容（Excel vba）

名簿シートの読み込み

これはシンプルな処理で、「名簿」シートのB列２行目からセルの値が空白になるまで読み込んで配列に入力しているだけです。

'名簿シートの読み込み
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

座席表シートへの書き込み

「名簿」シートから取得した名前のデータを含む配列をランダムに取り出して、取り出した値を「座席表」シートに書き込むだけの処理です。

ソースコードを見ると複雑そうに見えますがやっていることはシンプルです。

' 座席シート表への書き込み
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列（つまりセルの２列目）から座席表を書き込むように処理するためにつけています。

' 教卓を描く
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

まとめ

いかがでしょうか？

かなりざっくりした説明だったかもしれませんので、もし作るのがめんどくさいと感じた方は下記ボタンからダウンロードしてみてください。