はじめに：席替えルールの遵守状況確認の課題
学校やオフィスでの席替えは、人間関係の活性化や新鮮な環境の提供など、様々なメリットがあります。しかし、席替えにはいくつかのルールが設けられていることが一般的です。「〇〇さんの隣には△△さんを配置しない」「□□さんは窓際に配置する」といったルールは、円滑なコミュニケーションや快適な作業環境の維持に不可欠です。
ところが、これらのルールが実際に守られているかを確認する作業は、意外と手間がかかるものです。特に席替えの規模が大きい場合や、ルールが複雑な場合は、目視での確認には限界があり、ミスが発生するリスクも高まります。
そこで本記事では、Excel VBAを活用して、席替えルールの遵守状況を自動でチェックする方法をご紹介します。VBA100本ノックの98本目として、実践的な課題解決に焦点を当て、皆様の業務効率化に貢献できれば幸いです。
席替えルール確認の自動化：VBAの活用方法
席替えルールの確認をVBAで自動化するにあたり、まずはどのような情報をExcelで管理するかを整理しましょう。一般的には、以下の情報が必要になります。
* **現在の座席配置:** 各個人がどの座席にいるかの情報
* **席替えルール:** 適用されるべきルール（例：「AさんとBさんは隣り合わない」）
これらの情報をExcelシートに準備し、VBAコードで読み込んで照合することで、ルールの遵守状況を判定します。
1. データの準備
まず、Excelシートに座席配置とルールを記述します。
**A. 座席配置シート**
| 氏名 | 座席番号 |
| :—– | :——- |
| 山田太郎 | A1 |
| 佐藤花子 | A2 |
| 田中一郎 | B1 |
| … | … |
* 「氏名」列には、席替え後の各個人の氏名を記述します。
* 「座席番号」列には、各個人が配置されている座席番号を記述します。座席番号は、例えば「A1」「A2」のように、部屋のエリアと番号で管理すると分かりやすいでしょう。
**B. ルールシート**
| ルールID | 関係者1 | 関係者2 | 関係 |
| :——- | :—— | :—— | :— |
| 1 | 山田太郎 | 佐藤花子 | 隣り合わない |
| 2 | 田中一郎 | 山田太郎 | 隣り合わない |
| 3 | 佐藤花子 | 窓際 | 窓際配置 |
| … | … | … | … |
* 「ルールID」は、各ルールにユニークな識別子を付与します。
* 「関係者1」「関係者2」には、ルールが適用される対象の氏名または条件（例：「窓際」）を記述します。
* 「関係」列には、どのような関係をチェックするかを記述します。例えば、「隣り合わない」「隣り合う」「窓際配置」などです。
2. VBAコードの作成
次に、これらのデータを読み込み、ルールをチェックするVBAコードを作成します。
2.1. 隣接関係の定義
「隣り合わない」や「隣り合う」といったルールを判定するために、座席間の隣接関係を定義する必要があります。これは、座席番号と座席番号の組み合わせで定義できます。例えば、Excelの別のシートに以下のような隣接リストを作成しておくと便利です。
**C. 隣接リストシート**
| 座席1 | 座席2 |
| :—- | :—- |
| A1 | A2 |
| A1 | B1 |
| A2 | B2 |
| … | … |
このリストは、物理的な座席配置に基づいて手作業で作成するか、あるいは座席番号の命名規則（例：連番になっている）から自動生成することも可能です。
2.2. VBAコードの概要
VBAコードは、以下のステップで処理を進めます。
1. **データの読み込み:** 「座席配置」シートと「ルール」シートからデータを読み込みます。
2. **座席配置のDictionary化:** 氏名と座席番号の対応を素早く参照できるように、Dictionaryオブジェクトに格納します。
3. **隣接関係のDictionary化:** 隣接リストから、座席番号のペアとその隣接関係をDictionaryオブジェクトに格納します。
4. **ルールのチェック:** 「ルール」シートの各行に対して、以下の処理を行います。
* 関係者1と関係者2の座席番号を取得します。
* 「関係」列に応じて、定義した隣接関係のDictionaryを参照し、ルールが満たされているか判定します。
* 「窓際配置」のような単一の座席に対するルールも別途判定ロジックを設けます。
5. **結果の出力:** ルールを満たしていない箇所を、別のシートにリストアップします。
サンプルコード
以下に、上記の処理を行うVBAコードの例を示します。このコードは、基本的な考え方を示すものであり、実際の環境に合わせて適宜修正・拡張してください。
Option Explicit
Sub CheckSeatingRules()
Dim wsConfig As Worksheet
Dim wsRules As Worksheet
Dim wsSeating As Worksheet
Dim wsResult As Worksheet
Dim seatingData As Range
Dim rulesData As Range
Dim adjacencyData As Range
Dim seatingDict As Object ‘ Dictionary for seating: Name -> SeatNumber
Dim adjacencyDict As Object ‘ Dictionary for adjacency: SeatPairKey -> True/False (or “Adjacent”)
Dim ruleRow As Range
Dim person1 As String
Dim person2 As String
Dim seat1 As String
Dim seat2 As String
Dim relationship As String
Dim isRuleMet As Boolean
Dim rowIndex As Long
Dim resultRow As Long
‘ — 設定 —
Const SEATING_SHEET_NAME As String = “座席配置”
Const RULES_SHEET_NAME As String = “ルール”
Const ADJACENCY_SHEET_NAME As String = “隣接リスト”
Const RESULT_SHEET_NAME As String = “結果”
‘ — 初期化 —
On Error Resume Next
Set wsSeating = ThisWorkbook.Sheets(SEATING_SHEET_NAME)
Set wsRules = ThisWorkbook.Sheets(RULES_SHEET_NAME)
Set wsAdjacency = ThisWorkbook.Sheets(ADJACENCY_SHEET_NAME)
On Error GoTo 0
If wsSeating Is Nothing Then
MsgBox SEATING_SHEET_NAME & ” シートが見つかりません。”, vbCritical
Exit Sub
End If
If wsRules Is Nothing Then
MsgBox RULES_SHEET_NAME & ” シートが見つかりません。”, vbCritical
Exit Sub
End If
If wsAdjacency Is Nothing Then
MsgBox ADJACENCY_SHEET_NAME & ” シートが見つかりません。”, vbCritical
Exit Sub
End If
‘ 結果シートの準備
On Error Resume Next
Set wsResult = ThisWorkbook.Sheets(RESULT_SHEET_NAME)
If wsResult Is Nothing Then
Set wsResult = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
wsResult.Name = RESULT_SHEET_NAME
Else
wsResult.Cells.ClearContents ‘ 既存の内容をクリア
End If
On Error GoTo 0
‘ ヘッダー行の書き込み
wsResult.Cells(1, 1).Value = “ルールID”
wsResult.Cells(1, 2).Value = “関係者1”
wsResult.Cells(1, 3).Value = “関係者2”
wsResult.Cells(1, 4).Value = “関係”
wsResult.Cells(1, 5).Value = “判定結果”
wsResult.Cells(1, 6).Value = “詳細”
wsResult.Rows(1).Font.Bold = True
resultRow = 2
‘ Dictionaryオブジェクトの作成
Set seatingDict = CreateObject(“Scripting.Dictionary”)
Set adjacencyDict = CreateObject(“Scripting.Dictionary”)
‘ — 座席配置データのDictionary化 —
Set seatingData = wsSeating.Range(“A2”, wsSeating.Cells(Rows.Count, “B”).End(xlUp))
If seatingData.Rows.Count > 0 Then
For rowIndex = 1 To seatingData.Rows.Count
If seatingData.Cells(rowIndex, 1).Value <> “” And seatingData.Cells(rowIndex, 2).Value <> “” Then
seatingDict(seatingData.Cells(rowIndex, 1).Value) = seatingData.Cells(rowIndex, 2).Value
End If
Next rowIndex
Else
MsgBox SEATING_SHEET_NAME & ” シートにデータがありません。”, vbInformation
Exit Sub
End If
‘ — 隣接リストデータのDictionary化 —
Set adjacencyData = wsAdjacency.Range(“A2”, wsAdjacency.Cells(Rows.Count, “B”).End(xlUp))
If adjacencyData.Rows.Count > 0 Then
For rowIndex = 1 To adjacencyData.Rows.Count
If adjacencyData.Cells(rowIndex, 1).Value <> “” And adjacencyData.Cells(rowIndex, 2).Value <> “” Then
‘ 座席番号の順序を固定してキーを作成 (例: A1-A2 と A2-A1 を同じキーにする)
Dim seatA As String, seatB As String
If adjacencyData.Cells(rowIndex, 1).Value < adjacencyData.Cells(rowIndex, 2).Value Then
seatA = adjacencyData.Cells(rowIndex, 1).Value
seatB = adjacencyData.Cells(rowIndex, 2).Value
Else
seatA = adjacencyData.Cells(rowIndex, 2).Value
seatB = adjacencyData.Cells(rowIndex, 1).Value
End If
adjacencyDict(seatA & "-" & seatB) = True ' 隣接しているとマーク
End If
Next rowIndex
End If
' --- ルールのチェック ---
Set rulesData = wsRules.Range("A2", wsRules.Cells(Rows.Count, "C").End(xlUp))
If rulesData.Rows.Count > 0 Then
For Each ruleRow In rulesData.Rows
Dim ruleID As Variant
ruleID = ruleRow.Cells(1).Value
person1 = ruleRow.Cells(2).Value
person2 = ruleRow.Cells(3).Value
relationship = ruleRow.Cells(4).Value
isRuleMet = True ‘ 初期値はルールを満たしていると仮定
Dim detailMessage As String
detailMessage = “”
Select Case relationship
Case “隣り合わない”
If seatingDict.Exists(person1) And seatingDict.Exists(person2) Then
seat1 = seatingDict(person1)
seat2 = seatingDict(person2)
Dim seatPairKey As String
If seat1 < seat2 Then
seatPairKey = seat1 & "-" & seat2
Else
seatPairKey = seat2 & "-" & seat1
End If
If adjacencyDict.Exists(seatPairKey) Then ' 隣接リストに存在する場合
isRuleMet = False ' 隣り合わないルールなのに隣接している
detailMessage = person1 & "(" & seat1 & ") と " & person2 & "(" & seat2 & ") は隣接しています。"
End If
Else
isRuleMet = False ' どちらかの氏名が座席配置にない
detailMessage = "氏名が見つかりません: ";
If Not seatingDict.Exists(person1) Then detailMessage = detailMessage & person1 & " ";
If Not seatingDict.Exists(person2) Then detailMessage = detailMessage & person2 & " ";
End If
Case "隣り合う"
If seatingDict.Exists(person1) And seatingDict.Exists(person2) Then
seat1 = seatingDict(person1)
seat2 = seatingDict(person2)
Dim seatPairKeyAdjacent As String
If seat1 < seat2 Then
seatPairKeyAdjacent = seat1 & "-" & seat2
Else
seatPairKeyAdjacent = seat2 & "-" & seat1
End If
If Not adjacencyDict.Exists(seatPairKeyAdjacent) Then ' 隣接リストに存在しない場合
isRuleMet = False ' 隣り合うルールなのに隣接していない
detailMessage = person1 & "(" & seat1 & ") と " & person2 & "(" & seat2 & ") は隣接していません。"
End If
Else
isRuleMet = False ' どちらかの氏名が座席配置にない
detailMessage = "氏名が見つかりません: ";
If Not seatingDict.Exists(person1) Then detailMessage = detailMessage & person1 & " ";
If Not seatingDict.Exists(person2) Then detailMessage = detailMessage & person2 & " ";
End If
Case "窓際配置"
' この例では「関係者2」が「窓際」という文字列を指すことを想定
If person2 = "窓際" Then
If seatingDict.Exists(person1) Then
seat1 = seatingDict(person1)
' 窓際の座席番号のリストを別途定義するか、座席番号の命名規則から判定する必要があります。
' ここでは単純に「窓際」という文字列が含まれる座席番号を窓際とみなす例です。
' 実際には、窓際の座席番号のリストを管理するシートや配列を用意するのが良いでしょう。
Dim isWindowSeat As Boolean
isWindowSeat = False
' 例: 窓際座席のリスト (実際には別の場所で管理)
Dim windowSeats As Variant
windowSeats = Array("W1", "W2", "A1", "C1") ' 仮の窓際座席リスト
Dim wsSeat As Variant
For Each wsSeat In windowSeats
If seat1 = wsSeat Then
isWindowSeat = True
Exit For
End If
Next wsSeat
If Not isWindowSeat Then
isRuleMet = False
detailMessage = person1 & " (" & seat1 & ") が窓際に配置されていません。"
End If
Else
isRuleMet = False ' 氏名が座席配置にない
detailMessage = "氏名が見つかりません: " & person1
End If
Else
' 関係者2が「窓際」以外の場合は、ここでは処理しない（必要に応じて拡張）
End If
Case Else
' 未定義の関係性
detailMessage = "未定義の関係性: " & relationship
isRuleMet = False
End Select
' 結果シートに書き込み
wsResult.Cells(resultRow, 1).Value = ruleID
wsResult.Cells(resultRow, 2).Value = person1
wsResult.Cells(resultRow, 3).Value = person2
wsResult.Cells(resultRow, 4).Value = relationship
wsResult.Cells(resultRow, 5).Value = IIf(isRuleMet, "OK", "NG")
wsResult.Cells(resultRow, 6).Value = detailMessage
If Not isRuleMet Then
wsResult.Cells(resultRow, 5).Font.Color = RGB(255, 0, 0) ' NGの場合は赤色にする
End If
resultRow = resultRow + 1
Next ruleRow
Else
MsgBox RULES_SHEET_NAME & " シートにデータがありません。", vbInformation
End If
' 結果シートの列幅調整
wsResult.Columns("A:F").AutoFit
MsgBox "席替えルールの確認が完了しました。結果シートをご確認ください。", vbInformation
' オブジェクトの解放
Set seatingDict = Nothing
Set adjacencyDict = Nothing
Set wsSeating = Nothing
Set wsRules = Nothing
Set wsAdjacency = Nothing
Set wsResult = Nothing
End Sub
**コードの解説:**
* **`Option Explicit`**: 変数の宣言を強制し、タイプミスによるエラーを防ぎます。
* **`Sub CheckSeatingRules()`**: メインのプロシージャです。
* **`Dim`**: 必要な変数を宣言します。
* **`Const`**: シート名などを定数として定義し、コードの可読性と保守性を高めます。
* **`On Error Resume Next` / `On Error GoTo 0`**: シートが存在しない場合のエラー処理を記述します。
* **`CreateObject("Scripting.Dictionary")`**: Dictionaryオブジェクトを作成します。これは、キーと値のペアを格納するのに非常に便利で、データの検索を高速化します。
* **座席配置データのDictionary化**: 「氏名」をキー、「座席番号」を値としてDictionaryに格納します。これにより、氏名から座席番号をO(1)のオーダーで取得できます。
* **隣接リストデータのDictionary化**: 座席番号のペア（キーはアルファベット順にソート）をキーとして、隣接している場合は`True`を格納します。これにより、2つの座席が隣接しているかどうかの判定を高速に行えます。
* **ルールのチェック**: 「ルール」シートの各行をループ処理します。
* `Select Case`文で「関係」列の内容を判別し、適切な判定ロジックを実行します。
* **「隣り合わない」/「隣り合う」**: 関係者1と関係者2の座席番号を取得し、そのペアが`adjacencyDict`に存在するかどうかで判定します。座席番号のキーは、常に小さい順にソートされた文字列（例: "A1-A2"）として格納・検索することで、"A1-A2"と"A2-A1"のどちらの順序でも正しく判定できるようにしています。
* **「窓際配置」**: この例では、関係者2が「窓際」という文字列である場合に、関係者1の座席が窓際であるかを判定するロジックを仮で記述しています。実際には、窓際の座席番号のリストを別途管理するのが現実的です。
* **結果の出力**: ルールが満たされた場合は「OK」、満たされなかった場合は「NG」と判定結果を「結果」シートに出力します。NGの場合は、詳細なメッセージも表示します。
* **`AutoFit`**: 結果シートの列幅を自動調整します。
* **オブジェクトの解放**: 使用したDictionaryオブジェクトやWorksheetオブジェクトを解放します。
実務アドバイスと応用展開
このVBAコードは、席替えルールの確認を効率化する強力なツールとなりますが、さらに実務で活用するために、いくつかの点を考慮すると良いでしょう。
1. 複雑なルールの追加
* **「〇〇さんの隣には△△さんを配置しない」のような複合ルール**: 上記コードでは「関係者1」と「関係者2」の2名間のルールを想定していますが、より複雑なルール（例：「Aさんの隣にはBさんもCさんも配置しない」）を定義する場合は、ルールの記述方法や判定ロジックを拡張する必要があります。例えば、ルールシートに「条件」列を追加し、複数の条件をAND/ORで組み合わせられるようにするなどが考えられます。
* **「〇〇さんは〇〇エリアに配置する」**: 特定の属性（例：役職、部署）を持つ人を特定のエリアに配置するルールも、「窓際配置」の例のように、座席属性の管理と照合ロジックを追加することで対応可能です。
* **「〇〇さん同士は〇席以上離す」**: これは隣接関係だけでなく、座席間の距離を考慮する必要があります。座席番号の命名規則や、座席間の距離を計算する関数をVBAで作成する必要が出てきます。
2. データの管理方法の改善
* **座席番号の命名規則の統一**: 座席番号に一貫性のある命名規則（例：エリア名+番号）を用いることで、隣接関係や窓際判定などのロジックをよりシンプルに、あるいは自動化しやすくなります。
* **座席属性の管理**: 窓際、電源コンセント近く、通路側などの座席属性を別途シートで管理し、VBAから参照できるようにすると、より柔軟なルール設定が可能になります。
* **氏名の管理**: 氏名の表記揺れ（例：「山田太郎」と「山田 太郎」）はエラーの原因となります。VBAで文字列の前後の空白を削除する`Trim`関数や、あいまい検索を行う関数などを活用して、ある程度の表記揺れに対応できるようにすると良いでしょう。
3. ユーザーインターフェースの改善
* **ユーザーフォームの活用**: VBAのコードを直接編集するのではなく、ユーザーフォームを作成し、そこで座席配置データやルールを入力・編集できるようにすると、VBAの知識がないユーザーでも使いやすくなります。
* **ボタンによる実行**: フォーム上に「ルールのチェックを実行」ボタンを配置し、クリック一つで処理が開始されるようにすると、利便性が向上します。
* **結果の視覚化**: NGとなったルールを、元の座席配置シート上で色分け表示するなど、視覚的に分かりやすくする工夫も有効です。
4. 実行タイミングと頻度
* **定期的な実行**: 席替えのたびに手
