98本目 席替えルールが守られているか確認

VBA100本ノック 98本目を動画で解説しています。Excelの神髄さんの模範解答はコチラ

---

YouTube

作成した動画を友だち、家族、世界中の人たちと共有

www.youtube.com

問題

#VBA100本ノック 98本目
以下のルールで席替え（現→新）をしました。
ルールに反する席は（新）に黄色を塗ってください。
・全員が違う行列に移動。
・前後左右は前回と違う人。

例.B2「阿久津 美嘉」
・B列以外かつ2行目以外へ
・前後左右に「森井 さんま,赤坂 法子,
石橋 倫子,長野 扶樹」はNG。斜めはOK

解答

Sub ノック98本目()

    Dim ws現 As Worksheet: Set ws現 = Sheets("座席表（現）")
    Dim ws新 As Worksheet: Set ws新 = Sheets("座席表（新）")
    Dim r As Range
    Dim myDic As New Dictionary
    
    For Each r In ws現.Range("B5:G10") '現在の座席
        '値、行列、前後左右を取得
        myDic(r.Value) = Array(r.Row, r.Column, _
        r.Offset(-1).Value, r.Offset(1).Value, r.Offset(, -1).Value, r.Offset(, 1).Value)
    Next
    ws新.Range("B5:G10").Interior.Color = xlNone '塗りつぶしなし
    Dim flg As Boolean, n
    For Each r In ws新.Range("B5:G10")
        If myDic.Exists(r.Value) Then 'myDicにあるかどうかの確認
            flg = False
            If r.Row = myDic(r.Value)(0) Then flg = True '行数
            If r.Column = myDic(r.Value)(1) Then flg = True '列数
            For Each n In Array(r.Offset(-1), r.Offset(1), r.Offset(, -1), r.Offset(, 1))
                If Not n = "" Then
                    If n = myDic(r.Value)(2) Or n = myDic(r.Value)(3) Or n = myDic(r.Value)(4) Or n = myDic(r.Value)(5) Then
                        flg = True
                    End If
                End If
            Next
            If flg Then r.Interior.Color = vbYellow
        End If
    Next

End Sub

■考え方・流れ
0:00 冒頭・問題確認
2:04 使用するセル範囲をループさせる
3:53 dictionaryを使ってみる
7:34 dictionaryの中身を確認
10:13 dictionaryからアイテムを取り出す
12:56 行or列が一致したらセルを黄色に
15:46 前後左右誰か一人でも一致しているか確認

よし！ウォーミングアップ終了！

dictionaryを使ってみる

今日はついに！Dictionaryを使ってみるぞ！！
まずはイメージから確認だ！！
日本語の通り、「辞書」的なイメージでOKかと思う！

今回の問題に当てはめると…
キー→中岡 栄一
アイテム→中岡 栄一の行,列,前の人,後ろの人,右の人,左の人 てきな。

とまあ…イメージはこれくらいで！
実際に使う時は、「Microsoft Scripiting Runtime」を参照設定しよう！

変数名は「myDic」にして使っていこう！！
オブジェクトは New Dictionary でOK！

そしたらmyDicに、キーとアイテムを代入していくぞ！！
myDic(と書くと、Keyって出てくるぞん！
ここに席替え前の、席の名前を代入じゃい！！

こんな感じだ！↓

今回は6項目を紐づけたい！！
こんな時はArray関数を使って、配列をぶち込んであげるとGood！

その中身はこんな感じ！！

dictionaryからアイテムを取り出す

お次は！
席替え後と比較していくぞ！！！
まずは席替え後のセル範囲をループするところから！！

じゃあお次！
Dictionaryを使うにあたって、是非覚えておいてほしいメソッドがあるからその紹介！！
Existsメソッドさんだ！！

基本的には、Dictionaryを使う時は使うぞ！ww
ま、ただ、今回に限っては…
席替え前、席替え後で同じ36人を比較するからいらないんだがな…

じゃ、もし席替え後の席の名前の”キー”が見つかった場合！
席替え前のキーと紐づくアイテムを出力してみよう！

さっきローカルウィンドウさんで見たから、何やってるか分かるよな？

とりあえず一人分進めた結果↓
イメージついたかな？

行or列が一致したらセルを黄色に

よし！ここからは実際にセルを黄色くしていくぞ！
今回はフラグを作って書いていこう！

フラグってなんぞや？ってことなんだけど…
IF 行が一致したら…黄色に！
IF 列が一致したら…黄色に！
IF 前列が一致したら…黄色に！。。。って書くよりかは、
フラグをTrueにして、最後にyellow！みたいに書くことが多いかな！

flgって変数を作り、それがTrueかどうか判定していこう！

一旦、列と行が一致してた場合のみ、flgをTrueに変更↓

実行結果↓

前後左右誰か一人でも一致しているか確認

よし！あとはこの条件を追加して終わり！！
フラグのところを追加するだけだから、ごり押しで簡単だと思うじゃん？
だけど…模範解答はやっぱすごかったよ。
みんなも見てね。
私のはもちろんごり押し。

じゃ、前後左右を確認するぞ！
前後左右、4つの席のセルを配列にぶち込んで、その配列をFor Eachさんで処理していこう！

端っこの席を考慮して、空白のセルまで巻き込まないように分岐↓

じゃ、あとはごり押し！
Orを入れまくったらOKwwww

実行結果↓いい感じだね！

お疲れ…さまでした…！

あとがたり

おはこんばんちは。uぷ主です。
98本目！！席替えの問題！！！

SQLやAccessに比べたら…
100倍簡単で楽しい問題でした…www
皆さんはどうですか？

あ、何気にちゃんとDictionaryを使うのは初だったかも？
キーとアイテム！！あと配列！！
この関係さえちゃんとつかめてたら超便利です！！

98本目までこんな便利な機能出すの渋っててスミマセン！！！

あ、ちなみに来週もこのコードを使うから
これができなかった人は是非100回動画見てくれ！

あと2本！
あと2本！
あと2本！
あと2本！