Excel VBAで実用ツール(座席表作成編)
■宴会の座席決定を支援するツール
最近はコロナ禍で宴会を行う機会もなくなってしまいましたが、以前は数十人規模の宴会が年に何回も開催されていました。
ややフォーマルな宴会だったりすると、予め段取りや座席を決めておかなくてはいけない訳ですが、人数が多くなって来ると座席を決めるのも結構大変でした。
本稿では筆者が幹事の時に作成した、座席決定支援ツールを紹介します。
この宴会の出席者は30名強、広い和室に4つの島を準備しましたので、上座に主賓を座らせ、幹事3名を等間隔で配置することにしましたが、それぞれの島が均等に盛上るように残りのメンバーをバランス良く配置する必要がありました。
30人にもなると、頭の中で座席レイアウトを考えてもまとまらないので、Excelシートに貼付けた「シャッフル」ボタンで次項で紹介するツールを動かし、できあがった座席を眺めて今一だったら再度「シャッフル」するということを繰返した結果、なかなか良い感じの座席レイアウトができあがりました。
事前準備
「座席表」「work」というExcelシートを用意し、「座席表」シートには座席レイアウト、「work」シートにはシャッフルしたい座席数分の『座席番号』と『氏名』を入れたテーブルを作成します。
(「work」シートのイメージ)
A列を『座席番号』、B列を『氏名』とする以下のような表を用意し、『氏名』だけ手入力します。
⇒『座席番号』にはツールの実行結果が入りますので、入力は不要です。
座席番号 | 氏名 |
---|---|
AAA | |
BBB | |
・・・ |
(「座席表」シートのイメージ)
座席レイアウトに近い形で枠を配置し、シャッフルした結果を埋めたいセルに「=IFERROR(VLOOKUP(n,work!$A$2:$B$xx,2,FALSE),"")」という式を埋めます。
ここでnは1から配置したい座席数までの連番、$B$xxは「work」シートに作成したテーブルの最後のセルです。
⇒座席を固定したい箇所は、『主賓』『幹事』のように値を入力します。
幹事 | 主賓 | ・・・ | ||
・・・ |
サンプル・プログラム
行番号2~3で座席決定の範囲を指定し、行番号6で座席番号を格納する配列、行番号7で座席番号を格納したかどうかを示す配列(格納済の場合、True)を定義しています。
行番号12のRandomizeステートメントで乱数ジェネレータを初期化、行番号13~15で配列を初期化した後、行番号16~22の繰返し処理で乱数を基に座席番号を算出し、行番号23~25で「work」シートにセットしています。
行番号18ではRnd関数を使用して乱数を取得していますが、Rnd関数の戻り値は「0≦戻り値<1」のため、座席番号の範囲になるように「Int(MAX * Rnd + 1)」という計算を行っています。
- Option Base 1
- Const MIN = 1
- Const MAX = 28
- Dim sht As Worksheet
- Dim num As Integer
- Dim a_num(MIN To MAX) As Integer
- Dim flag(MIN To MAX) As Boolean
- Dim cnt As Integer
- Private Sub Sample1()
- Set sht = Worksheets(“work")
- Randomize
- For cnt = MIN To MAX
- flag(cnt) = False
- Next cnt
- For cnt = MIN To MAX
- Do
- num = Int(MAX * Rnd + 1)
- Loop While flag(num)
- a_num(cnt) = num
- flag(num) = True
- Next cnt
- For cnt = MIN To MAX
- sht.Cells(cnt + 1, 1) = a_num(cnt)
- Next cnt
- End Sub
■会議の座席表を作成するツール
前項で紹介したツールとほぼ同様ですが、定例会議の座席を毎回変更していた時期があり、Excelツールで座席を決めていました。
この宴会の出席者は13名で、正方形に並べた16席(1辺に4席ずつ)に配置するだけですが、「部長の隣は空ける」「1辺に3名以上配置する」という条件を設定し、条件を満たさない場合は自動的に再シャッフルする仕様にしていました。
事前準備
前項のサンプル・プログラムと同様、「座席表」「work」というExcelシートを用意し、「座席表」シートには座席レイアウト、「work」シートにはシャッフルしたい座席数分の『座席番号』と『氏名』を入れたテーブルを作成します。
(「work」シートのイメージ)
A列を『座席番号』、B列を『氏名』とする以下のような表を用意し、『氏名』だけ手入力します。
⇒『座席番号』にはツールの実行結果が入りますので、入力は不要です。
座席番号 | 氏名 |
---|---|
AAA | |
BBB | |
・・・ |
(「座席表」シートのイメージ)
座席レイアウトに近い形で枠を配置し、シャッフルした結果を埋めたいセルに「=IFERROR(VLOOKUP(n,work!$A$2:$B$xx,2,FALSE),"")」という式を埋めます。
ここでnは1から配置したい座席数までの連番、$B$xxは「work」シートに作成したテーブルの最後のセルです。
⇒下図の灰色のセルに数式を埋めます。
サンプル・プログラム
行番号2~3で座席決定の範囲を指定し、行番号6で座席番号を格納する配列、行番号7で座席番号を格納したかどうかを示す配列(格納済の場合、True)を定義しています。
行番号12のRandomizeステートメントで乱数ジェネレータを初期化、行番号13~27の処理を結果判定が"OK"になるまで繰返すこととし、その中の処理は前掲のサンプル・プログラムと同様で、行番号14~16で配列を初期化した後、行番号17~23の繰返し処理で乱数を基に座席番号を算出し、行番号24~26で「work」シートにセットしています。
行番号19ではRnd関数を使用して乱数を取得していますが、Rnd関数の戻り値は「0≦戻り値<1」のため、座席番号の範囲になるように「Int(MAX * Rnd + 1)」という計算を行っています。
行番号37~57の「結果判定」関数では、「部長の隣が空いていない」または「1辺の人数が3名未満」の時に"NG"を返しています。
また、行番号59~67の「氏名→座席変換」関数は「work」シートのテーブルを氏名で検索して座席番号を返し、行番号69~77の「座席→氏名変換」関数は逆に座席番号で検索して氏名を返しています。
- Option Base 1
- Const MIN = 1
- Const MAX = 16
- Dim sht As Worksheet
- Dim num As Integer
- Dim a_num(MIN To MAX) As Integer
- Dim flag(MIN To MAX) As Boolean
- Dim cnt As Integer
- Private Sub Sample2()
- Set sht = Worksheets(“work")
- Randomize
- Do
- For cnt = MIN To MAX
- flag(cnt) = False
- Next cnt
- For cnt = MIN To MAX
- Do
- num = Int(MAX * Rnd + 1)
- Loop While flag(num)
- a_num(cnt) = num
- flag(num) = True
- Next cnt
- For cnt = MIN To MAX
- sht.Cells(cnt + 1, 1) = a_num(cnt)
- Next cnt
- Loop Until 結果判定 = “OK"
- End Sub
- Private Function 結果判定() As String
- Dim 部長, 左隣, 右隣, 人数, i, j As Integer
- 結果判定 = “OK"
- 部長 = 氏名→座席変換(“部長")
- 左隣 = 部長 – 1
- If 部長 = MIN Then
- 左隣 = MAX
- End If
- 右隣 = 部長 + 1
- If 部長 = MAX Then
- 右隣 = 右隣 – MAX
- End If
- If (座席→氏名変換(左隣) <> “") Or (座席→氏名変換(右隣) <> “") Then
- 結果判定 = “NG"
- Exit Function
- End If
- For i = 1 To 4
- 人数 = 0
- For j = 1 To 4
- If 座席→氏名変換(4 * (i – 1) + j) <> “" Then
- 人数 = 人数 + 1
- End If
- Next j
- If 人数 < 3 Then
- 結果判定 = “NG"
- End If
- Next i
- End Function
- Private Function 氏名→座席変換(ByVal 氏名 As String) As Integer
- Dim i As Integer
- 氏名→座席変換 = 0
- For i = 2 To sht.Cells(Rows.Count, 2).End(xlUp).Row
- If 氏名 = sht.Cells(i, 2) Then
- 氏名→座席変換 = sht.Cells(i, 1)
- End If
- Next i
- End Function
- Private Function 座席→氏名変換(ByVal 座席 As Integer) As String
- Dim i As Integer
- 座席→氏名変換 = “"
- For i = 2 To sht.Cells(Rows.Count, 1).End(xlUp).Row
- If 座席 = sht.Cells(i, 1) Then
- 座席→氏名変換 = sht.Cells(i, 2)
- End If
- Next i
- End Function
出版社:インプレス
発売日:2022/3/23
単行本(ソフトカバー):A5判/912ページ
出版社:技術評論社
発売日:2021/1/9
単行本(ソフトカバー):A5判/800ページ
出版社:技術評論社
発売日:2019/11/25
単行本(ソフトカバー):B5変形判/576ページ
ディスカッション
コメント一覧
まだ、コメントがありません