VBA練習問題
VBA100本ノック 98本目:席替えルールが守られているか確認

VBAを100本の練習問題で鍛えます
最終更新日:2021-03-02

VBA100本ノック 98本目:席替えルールが守られているか確認


席替え前と後で、席替えルールが守られているか確認する問題です。


ツイッター連動企画です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。

VBAテスト用のサンプルデータは、VBA100本ノックの目次ページ からもダウンロードできます。
マクロVBAを初心者向けの基本から上級者向けの高度な内容までサンプルコードを掲載し解説しています。エクセル関数・機能・基本操作の入門解説からマクロVBAまでエクセル全般を網羅しています。


出題

出題ツイートへのリンク

#VBA100本ノック 98本目
以下のルールで席替え(現→新)をしました。
・全員が違う行列に移動
・前後左右は前回と違う人
例.B2「阿久津 美嘉」
・B列以外かつ2行目以外へ
・前後左右に「森井 さんま,赤坂 法子,石橋 倫子,長野 扶樹」はNG。斜めはOK。
ルールに反する席は(新)に色を塗ってください。

マクロ VBA 100本ノック

マクロ VBA 100本ノック


サンプルファイルです。
https://excel-ubara.com/vba100sample/VBA100_98.xlsm
https://excel-ubara.com/vba100sample/VBA100_98.zip


VBA作成タイム

この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。


他の人の回答および解説を見て、書いたVBAを見直してみましょう。


頂いた回答

解説

座席の名前をキーとして、座席の行列位置と前後左右の名前を値にしたDictionaryを(現)と(新)の両方で作成。
このDictionaryどうしの比較でルールをチェックしています。
前後左右が範囲外の場合の空白セル等の対応としてセル番地を入れておくことで後での比較をしやすくしました。

Option Explicit

Enum eResult
  Ok = 0
  Ng = 1
  Er = 9
End Enum

Sub VBA100_98_01()
  Dim rngCur As Range: Set rngCur = Worksheets("座席表(現)").Range("B5:G10")
  Dim rngNew As Range: Set rngNew = Worksheets("座席表(新)").Range("B5:G10")
  
  Select Case checkSeat(rngCur, rngNew)
    Case eResult.Ok: MsgBox "全席条件を満たしています。"
    Case eResult.Ng: MsgBox "黄色セルの席は条件を満たしていません。"
    Case eResult.Er: MsgBox "座席表(新)に席がない人がいます。"
  End Select
End Sub

'座席ルール確認のメイン処理
Function checkSeat(ByVal rngCur As Range, ByVal rngNew As Range) As eResult
  checkSeat = eResult.Ok
  rngNew.Interior.Color = xlNone
  
  Dim dicCur As Dictionary: Set dicCur = createDic(rngCur)
  Dim dicNew As Dictionary: Set dicNew = createDic(rngNew)
  
  Dim rng As Range, i As Long, vKey, vCur, vNew
  For Each vKey In dicCur
    '(新)に席がない場合のチェック
    If Not dicNew.Exists(vKey) Then
      checkSeat = eResult.Er
      Exit Function
    End If
    
    '行列前後左右の確認
    vCur = dicCur(vKey): vNew = dicNew(vKey)
    If Not checkRCUDLR(vCur, vNew) Then
      rngNew.Cells(vNew(0), vNew(1)).Interior.Color = vbYellow
      checkSeat = eResult.Ng
    End If
  Next
End Function

'行列前後左右の確認:0=行,1=列,2={上,3=下,4=左,5=右}
Function checkRCUDLR(ByVal aCur, ByVal aNew) As Boolean
  checkRCUDLR = False
  If aCur(0) = aNew(0) Or aCur(1) = aNew(1) Then Exit Function
  
  Dim v
  For Each v In aCur(2)
    'Filter結果(常に0開始)が1つは一致
    If UBound(Filter(aNew(2), v)) = 0 Then
      Exit Function
    End If
  Next
  checkRCUDLR = True
End Function

'各席情報を辞書に登録:'0=行,1=列,2={上,3=下,4=左,5=右}
Function createDic(ByVal aRng As Range) As Dictionary
  Dim dic As New Scripting.Dictionary
  Dim rng As Range
  For Each rng In aRng
    dic(rng.Value) = Array(rng.Row - aRng.Row + 1, _
                rng.Column - aRng.Column + 1, _
                Array(getValue(aRng, rng, -1, 0), _
                   getValue(aRng, rng, 1, 0), _
                   getValue(aRng, rng, 0, -1), _
                   getValue(aRng, rng, 0, 1)))
  Next
  Set createDic = dic
End Function

'座席範囲内ならValue、範囲外ならセル番地(隣接セルの空白や同値の対応)
Function getValue(ByVal aRng As Range, ByVal aTargetRng As Range, aRow As Long, aCol As Long) As String
  If Intersect(aRng, aTargetRng.Offset(aRow, aCol)) Is Nothing Then
    getValue = aTargetRng.Offset(aRow, aCol).Address
  Else
    getValue = aTargetRng.Offset(aRow, aCol).Value
  End If
End Function


前後左右の4か所どうしの比較部分をどのようにVBAで書くかが少し悩ましいですが、そこだけ気を付ければ良い問題だと思います。
記事にはVBAを掲載しています。
今回は席替え結果のチェックでした。さて次の99本目でこのルールで自動席替えをします。


補足

補足はありません。


サイト内関連ページ

第112回.動的配列(ReDim)
マクロVBAにおける配列の説明として最初に静的配列を解説しました。静的配列では要素数は宣言時点で決められていました。しかし、プログラミングをする上で、実行時点で要素数を決めたい場合や、実行途中で要素数を増減させたい場合が多く出てきます。
第113回.配列に関連する関数
マクロVBAで配列を使う上で、必要となるVBA関数がいくつかあります。より便利に配列を活用するために必須となるVBA関数、・LBound関数 ・UBound関数 ・Array関数 ・IsArray関数 ・Join関数 ・Filter関数 以上のVBA関数について解説します。
第114回.セル範囲⇔配列(マクロVBA高速化必須テクニック)
セル範囲をVariant型変数に入れる事で、配列を作成することができます。また、配列をセル範囲にまとめて出力する事も出来ます。これは、マクロVBAを高速処理したい時の必須テクニックになります、マクロの処理が遅い場合は、このテクニックが使えないか検討してください。
Dictionary(ディクショナリー)連想配列の使い方について
「Dictionaryオブジェクトについて簡単な使用例を上げて解説して欲しいです。」との要望をいただいたので、Dictionaryについて基本的な使い方を解説します。Dictionary(ディクショナリー)は名前の通り、辞書機能であり、連想配列とも呼ばれます。
Dictionary(ディクショナリー)のパフォーマンスについて
Dictionary(ディクショナリー)は辞書機能で、連想配列とも呼ばれます。この辞書は、重複は許されず、キーとデータの2つが存在します、今回はこのDictionaryのパフォーマンス(処理速度)を検証します。Dictionaryの基本的な使い方については、こちらを参照してください。




同じテーマ「VBA100本ノック」の記事

93本目:複数ブックを連結して再分割
94本目:表範囲からHTMLのtableタグを作成
95本目:図形のテキストを検索するフォーム作成
96本目:Accessデータを取得(マスタ結合&抽出)
97本目:Accessデータを取得(グループ集計)
98本目:席替えルールが守られているか確認
99本目:自動席替え(行列と前後左右が全て違うように)
100本目:WEBから100本ノックのリストを取得
魔球編:組み合わせ問題
魔球編:閉領域の塗り潰し
迷宮編:巡回セル問題


新着記事NEW ・・・新着記事一覧を見る

VLOOKUPを使うことを基本としてシートを設計すべきか|エクセル雑感(2021-08-17)
コンピューターはブラックボックスで良い|エクセル雑感(2021-08-14)
小文字"abc"を大文字"ABC"に変換する方法|エクセル雑感(2021-08-13)
ADOでテキストデータを集計する|VBAサンプル集(2021-08-04)
VBA学習のお勧めコース|エクセル雑感(2021-08-01)
エクセル馬名ダービー|エクセル雑感(2021-07-21)
在庫を減らせ!毎日棚卸ししろ!|エクセル雑感(2021-07-05)
日付型と通貨型のValueとValue2について|エクセル雑感(2021-06-26)
DXってなんだ? ITと何が違うの?|エクセル雑感(2021-06-24)
エクセルVBA 段級位 目安|エクセル雑感(2021-06-21)


アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得(End,Rows.Count)|VBA入門
2.Excelショートカットキー一覧|Excelリファレンス
3.変数宣言のDimとデータ型|VBA入門
4.RangeとCellsの使い方|VBA入門
5.繰り返し処理(For Next)|VBA入門
6.マクロって何?VBAって何?|VBA入門
7.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
8.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
9.セルに文字を入れるとは(Range,Value)|VBA入門
10.とにかく書いてみよう(Sub,End Sub)|VBA入門




このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。



このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
本文下部へ