Excel VBAで実用ツール（座席表作成編）

2022-03-102024-01-07

■宴会の座席決定を支援するツール

最近はコロナ禍で宴会を行う機会もなくなってしまいましたが、以前は数十人規模の宴会が年に何回も開催されていました。
ややフォーマルな宴会だったりすると、予め段取りや座席を決めておかなくてはいけない訳ですが、人数が多くなって来ると座席を決めるのも結構大変でした。

本稿では筆者が幹事の時に作成した、座席決定支援ツールを紹介します。
この宴会の出席者は30名強、広い和室に4つの島を準備しましたので、上座に主賓を座らせ、幹事3名を等間隔で配置することにしましたが、それぞれの島が均等に盛上るように残りのメンバーをバランス良く配置する必要がありました。
30人にもなると、頭の中で座席レイアウトを考えてもまとまらないので、Excelシートに貼付けた「シャッフル」ボタンで次項で紹介するツールを動かし、できあがった座席を眺めて今一だったら再度「シャッフル」するということを繰返した結果、なかなか良い感じの座席レイアウトができあがりました。

事前準備

「座席表」「work」というExcelシートを用意し、「座席表」シートには座席レイアウト、「work」シートにはシャッフルしたい座席数分の『座席番号』と『氏名』を入れたテーブルを作成します。

(「work」シートのイメージ)
A列を『座席番号』、B列を『氏名』とする以下のような表を用意し、『氏名』だけ手入力します。
⇒『座席番号』にはツールの実行結果が入りますので、入力は不要です。

(「座席表」シートのイメージ)
座席レイアウトに近い形で枠を配置し、シャッフルした結果を埋めたいセルに「=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)」という計算を行っています。

1. Option Base 1
2. Const MIN = 1
3. Const MAX = 28
4. Dim sht As Worksheet
5. Dim num As Integer
6. Dim a_num(MIN To MAX) As Integer
7. Dim flag(MIN To MAX) As Boolean
8. Dim cnt As Integer
10. Private Sub Sample1()
11.     Set sht = Worksheets(“work")
12.     Randomize
13.     For cnt = MIN To MAX
14.         flag(cnt) = False
15.     Next cnt
16.     For cnt = MIN To MAX
17.         Do
18.             num = Int(MAX * Rnd + 1)
19.         Loop While flag(num)
20.         a_num(cnt) = num
21.         flag(num) = True
22.     Next cnt
23.     For cnt = MIN To MAX
24.         sht.Cells(cnt + 1, 1) = a_num(cnt)
25.     Next cnt
26. End Sub

■会議の座席表を作成するツール

前項で紹介したツールとほぼ同様ですが、定例会議の座席を毎回変更していた時期があり、Excelツールで座席を決めていました。
この宴会の出席者は13名で、正方形に並べた16席(1辺に4席ずつ)に配置するだけですが、「部長の隣は空ける」「1辺に3名以上配置する」という条件を設定し、条件を満たさない場合は自動的に再シャッフルする仕様にしていました。

事前準備

前項のサンプル・プログラムと同様、「座席表」「work」というExcelシートを用意し、「座席表」シートには座席レイアウト、「work」シートにはシャッフルしたい座席数分の『座席番号』と『氏名』を入れたテーブルを作成します。

(「work」シートのイメージ)
A列を『座席番号』、B列を『氏名』とする以下のような表を用意し、『氏名』だけ手入力します。
⇒『座席番号』にはツールの実行結果が入りますので、入力は不要です。

(「座席表」シートのイメージ)
座席レイアウトに近い形で枠を配置し、シャッフルした結果を埋めたいセルに「=IFERROR(VLOOKUP(n,work!$A$2:$B$xx,2,FALSE),"")」という式を埋めます。
ここでnは1から配置したい座席数までの連番、$B$xxは「work」シートに作成したテーブルの最後のセルです。
⇒下図の灰色のセルに数式を埋めます。

サンプル・プログラム

行番号2～3で座席決定の範囲を指定し、行番号6で座席番号を格納する配列、行番号7で座席番号を格納したかどうかを示す配列(格納済の場合、True)を定義しています。

行番号12のRandomizeステートメントで乱数ジェネレータを初期化、行番号13～27の処理を結果判定が"ＯＫ"になるまで繰返すこととし、その中の処理は前掲のサンプル・プログラムと同様で、行番号14～16で配列を初期化した後、行番号17～23の繰返し処理で乱数を基に座席番号を算出し、行番号24～26で「work」シートにセットしています。
行番号19ではRnd関数を使用して乱数を取得していますが、Rnd関数の戻り値は「0≦戻り値<1」のため、座席番号の範囲になるように「Int(MAX * Rnd + 1)」という計算を行っています。

行番号37～57の「結果判定」関数では、「部長の隣が空いていない」または「1辺の人数が3名未満」の時に"ＮＧ"を返しています。
また、行番号59～67の「氏名→座席変換」関数は「work」シートのテーブルを氏名で検索して座席番号を返し、行番号69～77の「座席→氏名変換」関数は逆に座席番号で検索して氏名を返しています。

1. Option Base 1
2. Const MIN = 1
3. Const MAX = 16
4. Dim sht As Worksheet
5. Dim num As Integer
6. Dim a_num(MIN To MAX) As Integer
7. Dim flag(MIN To MAX) As Boolean
8. Dim cnt As Integer
10. Private Sub Sample2()
11.     Set sht = Worksheets(“work")
12.     Randomize
13.     Do
14.         For cnt = MIN To MAX
15.             flag(cnt) = False
16.         Next cnt
17.         For cnt = MIN To MAX
18.             Do
19.                 num = Int(MAX * Rnd + 1)
20.             Loop While flag(num)
21.             a_num(cnt) = num
22.             flag(num) = True
23.         Next cnt
24.         For cnt = MIN To MAX
25.             sht.Cells(cnt + 1, 1) = a_num(cnt)
26.         Next cnt
27.     Loop Until 結果判定 = “ＯＫ"
28. End Sub
30. Private Function 結果判定() As String
31.     Dim 部長, 左隣, 右隣, 人数, i, j As Integer
32.     結果判定 = “ＯＫ"
33.     部長 = 氏名→座席変換(“部長")
34.     左隣 = 部長 – 1
35.     If 部長 = MIN Then
36.         左隣 = MAX
37.     End If
38.     右隣 = 部長 + 1
39.     If 部長 = MAX Then
40.         右隣 = 右隣 – MAX
41.     End If
42.     If (座席→氏名変換(左隣) <> “") Or (座席→氏名変換(右隣) <> “") Then
43.         結果判定 = “ＮＧ"
44.         Exit Function
45.     End If
46.     For i = 1 To 4
47.         人数 = 0
48.         For j = 1 To 4
49.             If 座席→氏名変換(4 * (i – 1) + j) <> “" Then
50.                 人数 = 人数 + 1
51.             End If
52.         Next j
53.         If 人数 < 3 Then
54.             結果判定 = “ＮＧ"
55.         End If
56.     Next i
57. End Function
59. Private Function 氏名→座席変換(ByVal 氏名 As String) As Integer
60.     Dim i As Integer
61.     氏名→座席変換 = 0
62.     For i = 2 To sht.Cells(Rows.Count, 2).End(xlUp).Row
63.         If 氏名 = sht.Cells(i, 2) Then
64.             氏名→座席変換 = sht.Cells(i, 1)
65.         End If
66.     Next i
67. End Function
69. Private Function 座席→氏名変換(ByVal 座席 As Integer) As String
70.     Dim i As Integer
71.     座席→氏名変換 = “"
72.     For i = 2 To sht.Cells(Rows.Count, 1).End(xlUp).Row
73.         If 座席 = sht.Cells(i, 1) Then
74.             座席→氏名変換 = sht.Cells(i, 2)
75.         End If
76.     Next i
77. End Function