見出し画像

個サ作 #14 演習問題:あみだくじ 2

Haguruma J

こんにちは。

前回はあみだくじを作り始めました。

シートの準備とモジュールレベル変数、定数、初期処理の途中までやったんでしたね。

初期処理中のエラーチェックでは

  • 選択セルがグレーセルであること

  • 選択セルが単一であること

  • 選択セルがあみだくじ範囲の1行目であること

これらのことを担保したい、ということで実装したのでした。

今回はこの続きからいきます！それではどうぞ！


あみだくじ 中編

実行するくじの番号を取得

ではエラーチェックが終わったらいよいよくじを実行、すなわち線をなぞっていく行為をしたいのですが、まだひとつ情報が足りませんね。

どのくじが選択されたか？です。

ここまでは案外スマートな方法でエラーチェックができたんですけど、ここは泥臭い手段をとります・・・。どういうことかというと・・・

どろくさ～いしゅだん

こちら↑です！そのためにまずほしいのが上図で「ここから」と書かれた列番号と「ここまで」と書かれた列番号です。ループ処理の開始値と終了値というわけですね。

ではさっそくLet's実装！下記を下図のように追記ください。

    firstColumn = ActiveSheet.UsedRange.Item(1, 1).Column
    lastColumn = ActiveSheet.UsedRange.Columns.count + firstColumn - 1
コメントは必要に応じて自由につけてね。わかりやすいのが一番

変数firstColumnについては前回やった変数firstRowへの代入と近しいことをしています。「.Row」だった箇所が「.Column」になっただけです。

これで察しがつきますね。あみだくじ範囲内の1行目1列目のセルをシート全体からみたときの列番号を取得しています。

変数lastColumnについては少し補足しましょう。下図を見てください。

赤字 + 青字 = 緑字 になるかと思いきや赤字と青字で1列被ってる

「firstColumn」と「ActiveSheet.UsedRange.Columns.count」の値を足し算すればあみだくじの最後の列の番号が出てくるか？と思いますよね。

しかし、よく見ると「firstColumn」と「ActiveSheet.UsedRange.Columns.count」では1列被っているんですよね。なのでその差分調整のために最後に-1をします。

それをしたのが先ほどの・・・

    lastColumn = ActiveSheet.UsedRange.Columns.count + firstColumn - 1

このソースというわけです。

では、どんな方法で選択されたくじの番号を取得するか？これはこれまでやってきたことの応用になるのでちょっと考えてみてほしいです。

このあみだくじは1を開始値として左からくじをカウントする

これが期待値ですね。選択セルに応じて設定したい値です。

ひとつずつ確認する、という話をしましたので、ループ処理だという点は察しがついているでしょう。てかさっき言っちゃいましたね。ループの側がわはこちらです。

    '実行対象のくじが何番目かを取得する
    For i = firstColumn To lastColumn

    Next
現在の実装状態
再掲します。あとは左から右へ走査する処理を書くだけ

「ここから」「ここまで」のループをソースコードにしました。

開始列から終了列までをひとつずつ見ていきますが、思い出してほしいのが、ここで使いたい変数はすでに用意しています。変数tryLotIndexトライロットインデックスです。

で、今「0」の値をもってるんでしたね。関数initの冒頭で設定しました。

    '実行くじの番号初期値
    tryLotIndex = 0

これです。ということはこの変数に対して値を設定していくのでしょう。

  • 塗りつぶしなしのセルでなければ変数tryLotIndexに+1をする

  • 選択中セルの列番号と走査中セルの列番号が一致したらループを抜ける

ということをすれば何番目のくじが選択されているかがわかりそうです。

やってみましょう。ソースコードに落とし込むと・・・

        If i = Selection.Column Then
            tryLotIndex = tryLotIndex + 1
            Exit For
            
        ElseIf Cells(firstRow, i).Interior.Color <> NO_COLOR Then
            tryLotIndex = tryLotIndex + 1
            
        End If
現在の実装状態

こういうことになります。条件式が2つあるのでひとつずつ見ていきましょう。

まずはこちら

        If i = Selection.Column Then
            tryLotIndex = tryLotIndex + 1
            Exit For

変数 i には最初（1周目）、変数firstColumnが代入されています。ですからこれが、周回ごとに右へ右へとインクリメントされる列番号ですね。

そして「Selection.Column」というのが選択中セルの列番号です。ですので、これをイコールで比較しているということはこの条件式は選択中のセルにヒットした場合を指しています。

このケースでは変数tryLotIndexをインクリメント（今ヒットした分をカウント）すればあとは用なしになるのでExit Forによりループを脱出するという動きをすればOKです。

次に2つ目の条件式です。

        ElseIf Cells(firstRow, i).Interior.Color <> NO_COLOR Then
            tryLotIndex = tryLotIndex + 1

まず、こちらの条件式が評価されるときというのは先ほどのひとつめの条件式には合致しなかった、という事実があるので気にするのはセルの色だけでよいです。

ということは選択セルに到達する前にグレーセルを通りがかったときに入る処理ですね。グレーセルを通過したことをカウントしないといけないので変数tryLotIndexをインクリメントします。

そして、ここではまだ選択セルに到達していない、ということなのでExit Forはせずに次の周回へと続きます。

これで変数tryLotIndexにも適切な値が設定されましたね。

念のため、動作確認をしましょう。現状のソースでは画面の動きから妥当性の確認のしようがないので、以下を一時的に追加します。ループの外に追記しましょう。動作確認が終わったら消しましょうね。

    MsgBox "選択されたくじは " & tryLotIndex & " 番目です。"

ではいきます。

選択されたくじが何番目かを設定する処理が正常に動いていることを確認している様子

OKです。今追加したソースは削除かコメントアウトしておいてください。

これでinit関数は完成です。やったね。

それではマクロ「I_あみだくじ1()」の方に戻りましょう。


あみだくじ1の実装 処理中断編

init関数によってエラーチェックと各変数の初期値を設定しました。それではいよいよあみだくじの設定に入りたいのですが、まだやることがあります。

先ほどまでで実装したエラーチェックの中で、エラーに抵触した場合はExit Functionをしましたよね。そう、関数を抜けました。

でね、この場合は関数を抜けるだけじゃなくSubプロシージャごと処理を中断したいんです。初期処理でこけてるのにこれ以上処理を続けても意味がないから。

でも今の状態ってエラーに抵触したらただ呼出し元である「I_あみだくじ1()」に帰ってきただけでまだ処理を進めようとしています。

ですから、こっちはこっちで明示的に終了してやらないといけません。ただinit関数からなにも戻り値として受け取っていないのにどうやって

  • 最後まで処理を終えて返ってきたのか

  • エラーに抵触したExit Functionで返ってきたのか

これらを判断すればよいでしょうか。

ここでinit関数をよ～く見返してほしいんです。エラーに抵触したことで戻ってくるときと最後のループ処理を終えた上で戻ってくるとき、ある変数だけ値に変化があります。


そう、変数tryLotIndexトライロットインデックスです。

こちらはエラーチェックの前に「0」を代入していますから、エラー抵触ていしょくによってマクロ側に強制帰還された場合は「0」のままです。

前回#13で「0」はエラーチェックで使用するって言っていたのがこれです。init関数が正常終了かどうかを判定するための印としてinit関数冒頭で「0」を設定しているんですね。

対して、引くくじの番号を探す処理を経た場合は必ず1以上の値が入っています。これをキーにマクロ側でも処理を中断する処理を書きましょう。

下記を下図のようにお願いします。

    If tryLotIndex = 0 Then
        Exit Sub
    End If
今、追加してほしいソースコード

このようになります。


あみだくじ1の実装 色取得編

ここまで来たらいよいよ色を塗り替えていくロジックの実装か？と思うじゃないですか。まだ足りない・・・まだ足りないんです・・！

肝心のものを用意していません。何色で塗り替えていくねん！という話なんです。

はい、色を用意しましょう。

完成形が動作する様子

これを見てると操作中のどこで色を指定しているわけでもないのに、各線を異なる色でなぞってくれていますよね。やだ素敵, かっこいい, 惚れちゃう。

画面上で指定していないということは内部で色を自動設定する処理が働いている、という点は容易に想像がつくでしょう。

そうです。実はあらかじめ1番目なら〇色、2番目なら〇色、3番目なら〇色・・・という風に決まっています。

異なるいくつかの情報を1か所で管理したい、と言えば？はい、もうおわかり。配列はいれつの出番ですね。

モジュール「Study2」のisDayWritable関数の中に

    '31日まである月を格納する配列
    Dim monthWith31DaysArray() As String
    monthWith31DaysArray = Split("1,3,5,7,8,10,12", ",")

こんな記載があります。この時はSplitスプリット関数の力を借りて簡単に配列を用意しました。文字列をカンマ区切りで配列化しているのでしたね。

今回は正規せいきの方法で配列を用意します。

新しい関数を用意するのですが、ここはもったいぶっても仕方ないので一気に完成形をご案内します。以下です。追記ください。

'セル塗色用の色配列を取得する
Function getColors()
    Dim colors(10) As Long
    colors(0) = 192
    colors(1) = 5287936
    colors(2) = 255
    colors(3) = 15773696
    colors(4) = 49407
    colors(5) = 12611584
    colors(6) = 65535
    colors(7) = 6299648
    colors(8) = 5296274
    colors(9) = 10498160
    getColors = colors
End Function
赤枠のソースコードを反映してね

場所はひとまずどこでもいいです。私はinit関数の次にします（関数の順序に関する話は#16の補足で少し触れます）。

配列の宣言方法は補足の章で触れますね。今のあなたなら上記のソースをパッと見ただけでだいたい何してるかわかるでしょうし。

このソース、最後に関数名にcolorsを代入しているので、呼び出し元にこの配列を戻す、という働きをしていますね。

そして各要素に代入しているよくわからない数値たちは何かしらの色を表しています。ここの色はあなたのお好みにしていただいていいですよ。てかした方がいい！その方が楽しいと思う！

ここで再び出番を得るのが関数aです！

Sub a()
    'Debug.Print Selection.Interior.Color
    ActiveSheet.UsedRange.Select
End Sub

今こんな状態ですが、Debug.Print~の方をアンコメント（コメントアウトの解除）していただいて、ActiveSheet~の方は削除しちゃってOKです。

これでいろんな色を用意しちゃってください。もちろん私が用意したモノを使いまわしますって方はそれでもOKです。


では呼び出し元の実装です。下記を下図のようにお願いします。

    '塗り替える色の取得
    Dim colors() As Long: colors = getColors()
    repaintColor = colors(tryLotIndex - 1)
追記してほしいソースコード

こんな感じでOKです。1行目は配列型変数宣言と値の取得をしていますね。関数が返してきた値をそのまま代入しています。

で！ちょっとニヤッとしちゃうのがこの2行目なんですよ・・・。見て。

    repaintColor = colors(tryLotIndex - 1)

10色を保持する配列の要素にあみだくじの番号でアクセスしてる・・・！ここ、配列は「0」から始まるけど、くじの番号は「1」から始まるので -1 することでそのズレを調整しています。

ちょっとだけトリッキーですよね,ちょっとだけ。テクニカルというか。このようにすることで各くじの番号ごとに異なる色を設定することができます。

変数repaintColorもモジュールレベル変数なので、マクロ内での宣言は不要です。

これで前提条件としては整いました。いよいよあみだくじの実装です。


クリア処理のお渡し

このあとの流れとして何度かあみだくじを実行していくことになります。その時、くじのセルが塗り替えられていくのですが、そのたびに手動で元のグレーセルに戻すのはけっこう面倒です。

なので、クリア処理用のソースコードをプレゼントします。私としましては、ソースコードを渡すからには解説しないわけにはいかないんですが、実はこのソースはまだ習っていない二重ループを駆使しています。

ですので、今はプレゼントだけして解説は二重ループが出てくるカレンダーLv.6の時、#15で行います。

    firstRow = ActiveSheet.UsedRange.Item(1, 1).Row
    lastRow = ActiveSheet.UsedRange.Rows.count + firstRow
    firstColumn = ActiveSheet.UsedRange.Item(1, 1).Column
    lastColumn = ActiveSheet.UsedRange.Columns.count + firstColumn
    
    For i = firstRow To lastRow
        For j = firstColumn To lastColumn
            If Cells(i, j).Interior.Color <> NO_COLOR And Cells(i, j).Interior.Color <> YET_TRY_COLOR Then
            
                Cells(i, j).Interior.Color = YET_TRY_COLOR
                Application.Wait [Now() + "0:00:00.0001"]
            
            End If
        Next
    Next

これをですね、「L_あみだくじ初期化1」の中に貼っつけちゃってください。

こんな風にできたらOK

動作確認はこのあと必要になったときにやります。お楽しみに。


実装方針の辺りをつけよう

これを見てあみだくじの実装方法を考えてほしい

上図を見ていただいて、まずどうやってこの実装を攻略していくのか？なのですが・・・

  • 進行方向は塗りつぶしなしの色以外であること

  • 基本的に下に進む

  • 右・左があればそちらを優先する

  • セルを進んだら色を塗り替え、また次の進行方向を精査する

  • 進行先に塗りつぶしなしの色しかないなら処理を終了する

だいたいこのようなルールがあればクリアできるのかなと、推測します。

ひとつめの

  • 進行方向は塗りつぶしなしの色以外であること

について。こちらはグレーセルであることを進行方向に決定する条件とすればいいと思ったのですが、既に他のくじを引いた後だったらグレーセルとも限らないんですよね。2本目, 3本目の時ってね。それ以降も。

グレーじゃないけどその線を通りたい、というケースもありうるので「塗りつぶしなしの色以外であること」としています。


実装方針の大枠ですが、なんとなーく・・・「ループ処理か？」と思ってはいませんか？その考え・・・正解です！

ただし、先ほどクリア処理の件で二重ループはカレンダーLv.6でやると言ったからこれは違います。じゃあ一重のループでやるのか？できるのか？

まぁ正解っちゃ正解でしょう。一重です。ただし、これまで使ってきたForによるループではありません。

Doドゥー Whileホワイルループ　です！


Do Whileループとは

これは通常のforループよりもう少し柔軟性じゅうなんせいのあるやつでして、とある条件を満たしたらループ終了、とするタイプの反復処理です。

その「とある条件」はこちら（プログラマ）によって自由に決めることができます。今回で言うならまだくじを進めてもいいのかどうか？が「とある条件」になります。

ですので、まだ進められるか、もう進められないかを管理する真偽値変数をひとつ用意しましょう。

    'あみだくじ進行を続けるかどうかのフラグ
    Dim isContinue As Boolean: isContinue = True
赤枠のソースコードを反映してね

これでOKです。#7にて、Boolean型の変数は「is」から始まる変数名としましょう、という話をしました。それに則っています。「Continueコンティニュー」には続けるという意味があります。

続きに下記を下図のように追記してください。

    Do
    
    
    Loop While isContinue
赤枠のソースコードを反映してね

はい、この「Do」と「Loop While isContinue」の間の行にあみだくじに必要な処理を書き連ねていきます。

「Loop While」の後に今用意した変数isContinueを書きました。構文としては

Do
~~ループ内の処理内容~~
Loop While [継続条件]

という書き方をします。

ループしていくということは1マス進むことがループの1周です。ひとつ進んで色付ける、ひとつ進んで色付ける、の繰り返しです。

その中でもうこれ以上は進めない！となったらループを終了します。すなわち先ほど宣言した変数isContinueにFalseを代入します。継続条件を満たさない、ということですね。

上記構文の[継続条件]は変数や数式を指定することができ、その値なり結果なりがTrueなら次の周回に移ります。Falseならループ終了です。

さて、「進む」と「色をつける」は毎周必ず行う処理ですので、それをまず書いてしまいましょう。

・・・の前に引く対象のくじが辿るセルを表すのが変数tryLotRangeくんという話でした。この先の処理では彼を1マスずつ進めていきます。ということは彼にめちゃくちゃ干渉していきます。

同じオブジェクトを何度も使うときに利用したいテクニックと言えば？はい、カレンダーLv5の#12でやりましたね。Withウィズステートメントです。

まずWithで囲っちゃいましょう。

    Do
        With tryLotRange
        
        
        End With
    Loop While isContinue
赤枠のソースコードを反映してね

こんな風になればOK。


無限ループを知ろう

では、いよいよくじを進める処理を書いていきます。

「ここ」のところが選択された状態で処理が実行されるとして、まず何をすべきか考えてほしい

たとえば、上図の選択位置から処理が始まる時、まず最初にすることはなんでしょう。

はい、そうです。色を塗るですね。

そして、もうひとつあります。今はループの1周目をやっているからイメージしにくいですが、毎周1セル移動するということをしないと、視覚的にセルの動きを追うことはできません。

ですので、セルを選択状態にします。次の2行をWithステートメント内の最初の処理として記載ください。

            '1セル進む
            .Select
            .Interior.Color = repaintColor
赤枠のソースコードを反映してね

はい。Selectはカレンダーでも嫌というほどやってきているのでもういいでしょう。色塗りの方は「Interior.Color」プロパティに先ほど設定した変数repaintColorの値を代入しています。これにより色が塗り替えられます。

この状態でね、一度動かしてみようと思います。

これ、あなたの方でもやる前に念のため[Ctrl] + [S]キーで保存してください。そして、実行前に私がやる様子を見てください。いきます。

現在のソースコードで実行する様子。処理が終わらないから自分で終了させている

いかがでしょう。「実行1」ボタンを押してから、最初のセルは色を変えるのですが、その後マウスカーソルが待機状態になり、永遠に処理が終わらないんです。

これが、俗にいう無限ループというやつです。変数isContinueがずっとTrueのままだから継続条件を満たしたままなんですね。処理が終わりません。

でも上図のGif画像では途中で

このダイアログが出てきて、処理を終了していますよね。そのやり方をお教えします。

ソースコードの不備や無限ループで処理が終わらない！というときはキーボードの左上にある[Esc]キーを押下してください。エスケープキーです。

これで処理が途中でも強制終了させられます。1度の押下で中断されないときは2, 3度押してください。

今回実行前に念のために保存しておくようお願いしたのですが、この辺りは補足の章で触れます。

では実装を進めましょう。ひとまず色を塗る、の動作はOKです。


Offsetプロパティ

くじを進めていきます。

あみだくじを進めるとき、右、下、左とあるのですが、まず考えたいのが、優先順位ですね。

左と下へ分岐できる状況のくじ

上図のような状況があった場合、あみだくじのルールとして進むのは左です。右・左は下よりも優先されるべきですね。そしてあみだくじを作図いただくときに

  • 一つの縦線につき、同じ位置から左右に伸びる線を書かない

このようなルールを設けています。つまり、右・下・左すべての選択肢が同時に訪れることはありません。右と下か左と下の組み合わせです。

よって、右と左に関してはどちらを先に評価してもOKです。同時に現れることがないのでね。

では今回は右、左、下の順番で評価しましょう。

今選択されているセル位置からひとつ右、ひとつ左、ひとつ下のセルを確認します。そんなとき活躍するのがRangeオブジェクトがもつOffsetオフセットプロパティです。

オフセットという言葉はあまり聞きなれないかもしれませんね。

ITの分野では、何かの位置を指し示す際に、基準となる位置からの差（距離、ズレ、相対位置）を表す値のことをオフセットということが多い。

IT用語辞典 - オフセット 【offset】

公式リファレンスには・・・

指定された範囲からオフセットした範囲を表すRangeオブジェクトを返します。

Microsoft Ignite - Range.Offset プロパティ (Excel)

と記載があります。文脈からして上記の「オフセットした」は「基準セルから相対的にずらした～」というように解釈ください。

では、ソースコードに参りましょう。ここで一気に追加します。下記を下図のようにお願いします。

            If .Offset(0, 1).Interior.Color <> NO_COLOR Then
                '右へ移動
                Set tryLotRange = .Offset(0, 1)
            ElseIf .Offset(0, -1).Interior.Color <> NO_COLOR Then
                '左へ移動
                Set tryLotRange = .Offset(0, -1)
            ElseIf .Offset(1, 0).Interior.Color <> NO_COLOR Then
                '下へ移動
                Set tryLotRange = .Offset(1, 0)
            Else
                '移動先がない。処理を終了
                isContinue = False
            End If
赤枠のソースコードを反映してね

ありがとうございます。

まずはOffsetプロパティの使い方ですね。このセルを取得することに関して、似たようなパターンを見たことがないですか。ありますよね。

そう、Cellsプロパティです。カレンダーで使いまくりましたが、

Cells(1, 6).Value

たとえば、上記のような記載があったらこれは1行目の6列目にあたるセルを返してくれます。Offsetの公式リファレンスから拝借しますと・・・

パラメーター（引数のことです）にはRowOffsetロウオフセットとColumnOffsetカラムオフセットを指定するように書いてます。つまり、基準位置のセルから行方向にいくつずらすのか？列方向にいくつずらすのか？を指定します。

なので、これまでも使ってきたCellsプロパティとイメージは同じです。基準位置からの差異分を指定する、という考え方で差し支えありません。

今回、With句の中にあるからわかりにくいのですが、実際は

tryLotRange.Offset(0, 1).Interior.Color

ということです。変数tryLotRangeの位置がOffsetで別のセルにアクセスする上での基準位置なんですね。そして、Offset(n, n)には第一引数に行方向の移動数、第二引数には列方向の移動数を指定するため・・・

なんかUNOを連想させる色使い

このようなイメージです。基準位置から上と左に移動しようとするとエクセル表としてはマイナス方向になるので、マイナスの値を指定します。

これを踏まえて再度ソースを見てみると・・・

            If .Offset(0, 1).Interior.Color <> NO_COLOR Then
                '右へ移動
                Set tryLotRange = .Offset(0, 1)
            ElseIf .Offset(0, -1).Interior.Color <> NO_COLOR Then
                '左へ移動
                Set tryLotRange = .Offset(0, -1)
            ElseIf .Offset(1, 0).Interior.Color <> NO_COLOR Then
                '下へ移動
                Set tryLotRange = .Offset(1, 0)
            Else
                '移動先がない。処理を終了
                isContinue = False
            End If

理解しやすいでしょう。

If文の条件式についても解説します。それぞれのOffsetは要するに進行方向のセルを示しているわけですが、その進行予定セルが「NO_COLOR」ではないかどうか？を評価しています。

定数NO_COLORは塗りつぶしなしの色値をもっていますよね。そこはあみだくじの対象外ですから、そうではなかったら進行方向として有効である、という考え方でロジックを組んでいます。

右、左、下のいずれかの条件式でTrueとなれば次の進行方向セルを変数tryLotRangeに代入し、次の周回へ向かう、という流れになります。

そして最後の分岐・・・

            Else
                '移動先がない。処理を終了
                isContinue = False
            End If

ここに入るということはこれまでの条件式をすべてパス（通過）してきた、すなわちもう進行できる方向がない＝処理を終了する、ということを示しています。

ここではじめて変数isContinueにfalseを代入します。そうすると次の継続条件評価では「偽」の結果が返るので、ループを抜けるという流れになります。


条件式のブラッシュアップ

さて、これで実装が完了したのではなかろうか・・・。もう一度動かしてみましょう。

今のソースコードの状態で動かそうとする様子

いやいやいや！ちゃんと動かへんのか～い！

はい、そうなんですよね。

実装してみてこれで動くぞ、と思いきや動かない、ということの繰り返しなんですね。プログラミングって。それでどこが悪かったのかをソースコードと相談して改善を図っていきます。

さて、上図の動作を参考に何が原因だったのかを考えてみましょう。


まず、上図でいうところの緑の線は左に進みたいのに途中から右、左、右、左・・・という文字通り右往左往の動きをしています。

この緑はこの状態からこれ以上左に進まなかった

この状態で次に移動したいのは左です。でも右に移動している。何が起きているかというと・・・

            If .Offset(0, 1).Interior.Color <> NO_COLOR Then
                '右へ移動
                Set tryLotRange = .Offset(0, 1)
            ElseIf .Offset(0, -1).Interior.Color <> NO_COLOR Then
                '左へ移動
                Set tryLotRange = .Offset(0, -1)

ここのソースコードで右方向への移動を左よりも先に評価しているんですよね。

で、この右に移動するための条件が移動予定のセルが塗りつぶしなしではない、としています。

既に緑に塗られた状態は「塗りつぶしではない」に該当しますから、こっちがTrueになってしまうんです。その結果

選択セルはひとつ前（右）に戻ります。で、この状態からするとひとつ右は「塗りつぶしなし」のセルで進行不可ですから、次に左方向の条件式を評価するんです。

これで右にいったり左にいったりするんですね。右往左往・・・

じゃあ左の評価を先にすればいいのか？というと・・・

右・左の評価順を左が先にした場合の動作。結局同じことが起きちまうんだ

そんなわけがなくて、左側の角で同じことが起きるんですね。

と、なったらロジックを修正しましょう。今、左に移動したいのに右の条件式で「真」の結果になってしまったのが問題でした。

「塗りつぶしなしの色以外か？」に加えて「自分の色ではないか？」も加えたらこの問題は解決しそうではないですか。

隣接セルが自分の色であることで「塗りつぶしなしの色以外か？」がTrueになっちゃってるわけですからね。下図のようにお願いします。

            If .Offset(0, 1).Interior.Color <> NO_COLOR And .Offset(0, 1).Interior.Color <> repaintColor Then
                '右へ移動
                Set tryLotRange = .Offset(0, 1)
            ElseIf .Offset(0, -1).Interior.Color <> NO_COLOR And .Offset(0, -1).Interior.Color <> repaintColor Then
                '左へ移動
                Set tryLotRange = .Offset(0, -1)
            ElseIf .Offset(1, 0).Interior.Color <> NO_COLOR And .Offset(1, 0).Interior.Color <> repaintColor Then
                '下へ移動
                Set tryLotRange = .Offset(1, 0)
            Else
                '移動先がない。処理を終了
                isContinue = False
            End If
赤枠のソースコードを反映してね

進行方向のセル色が変数repaintColorの値ではないこと（＝まだ自分色に染めてないセルか？）、という条件も追加してみました。これならどうでしょうか。

自分色に染めるって・・・//

で、で、で、で・・・できたどーーー！！！！！！！！！

うおおおおおおおおおおお！！！！！！！！！！！！！！！！！！

なんだ、案外簡単じゃん！！！

はい、無事動いたのですが、ちょっとなぞる速度がはえーなって方は例によって以下のソースを追記ください。私は書いておきます。

Application.Wait [Now() + "0:00:00.001"]
速度調整のソースです。
これで実行してみると塗色の速度が少し穏やかになった

はい、ちょっと可愛らしい速度になりました。


宿題！

さて、このあみだくじは「演習問題」という枠組みでの取り組みでした。そして#13にて異なるロジックで2回やるよ、とお伝えしています。1回目は一緒に。2回目はあなた自身で、です。

いよいよ2つ目の実装をあなた自身にやっていただくところまできています。事前準備完了、という状況でございます。前項までで完成したのに、何をやるの？とお思いでしょう。

このあみだくじの精度をもう少し上げたいと思います。2点あります。

実用面を考えたとき、一度引いたくじをもう一度引く、ということがきっとあるでしょう。

下図は「実行2」ボタンから行う様子なのですが・・・

これがあなたに実装いただくあみだくじの期待値の動作

一度引いたものも、後から引いた他のくじにより色が上書きされてしまうことがあるけれど、もう一度引くことで再度色を塗りなおす、という動きをしています。

今、これを「実行1」ボタンでやるとですね・・・

やりたいことができない哀れな状態

なにも起きないんですよ。なぜなら進行方向のセル色がすでに今塗り替えようとしている色になっていたらそっちには進まない、という処理をつい先ほど追加したからです。

よかれと思ってやったことがマイナスに働いているわけです。これ、結構あるあるです。もぐらたたきみたいにひとつの問題を解決したと思ったらまた別のところで問題が出てきちゃう。

今お伝えしたことが次のあみだくじ2の実装で改善していただきたいことの一つ目です。そしてもう一つ。あみだくじを作図するとき・・・

  • 辿ったとき、進行方向が上向きになる線は書かない

というルールを設けましたが、これを撤廃てっぱいしましょう。現実世界であみだくじを書くときもちょっとしたいたずら心をもって上方向に進む線を書き加えたりしますよね。これを可能にします。


まとめますと・・・

  • 複数回実行しても同じ動作をする

  • 上方向の進行も可能とする

この2点を実現してください。実装するマクロはJ_あみだくじ2にお願いします。

正解の動作としては・・・

ひとつずつ実行するのが面倒だから各くじを2回ずつ引くマクロを利用している

このようになります。上向きの進行になる線も追加しています。


一括実行ソースのお渡し

さて、上図は各くじの実行までもプログラムが自動でやってくれていますね。しかも2回ずつ。これから何度もトライ&エラーが発生すると仮定した場合、ひとつずつ実行するのはとても面倒です。

そのストレスを回避するために一括実行を可能としました。今回はソースをお渡しするだけで解説は控えておきます（たぶん読んだら分かるだろうからね）。

「K_あみだくじ一括実行」の側だけ用意しているかと思います。以下のようにしてください。

Sub K_あみだくじ一括実行()
    firstRow = ActiveSheet.UsedRange.Item(1, 1).Row
    firstColumn = ActiveSheet.UsedRange.Item(1, 1).Column
    lastColumn = ActiveSheet.UsedRange.Columns.count + firstColumn
    
    For i = firstColumn To lastColumn
        If Cells(firstRow, i).Interior.Color <> NO_COLOR Then
            Cells(firstRow, i).Select
            Call J_あみだくじ2
            Cells(firstRow, i).Select
            Call J_あみだくじ2
        End If
    Next
End Sub
赤枠のところに貼り付けてね

一括実行ボタンとこのマクロが紐づけてあればもう動かすことができます。

では、今回はこれで終わりです。


今回の補足

今回は盛りだくさんでした。が、ちょっと説明が甘くなったところや伝えきれていないところがあるので、そこだけ補足させてください。

配列の宣言方法と次元のお話

本編で配列を宣言しましたが、その解説は補足の章に譲るとしていました。

今回実装いただいた・・・

    Dim colors(10) As Long
    colors(0) = 192
    colors(1) = 5287936
    colors(2) = 255
    colors(3) = 15773696
    colors(4) = 49407
    colors(5) = 12611584
    colors(6) = 65535
    colors(7) = 6299648
    colors(8) = 5296274
    colors(9) = 10498160

こちらを例に解説しましょう。まず、

    Dim colors(10) As Long

こちらの行はほぼ見たことがあるでしょう。ないとすれば「(10)」←この部分ですね。まず、括弧をつけることで「これは配列ですよ」という宣言になっています。

そしてこの「(10)」の「10」という数字は格納できる要素の数です。宣言した時点で要素数を確定させる配列を固定長こていちょう配列とか静的せいてき配列と言います。

また、宣言時には要素数を決めない、ということもできます。その場合は可変長かへんちょう配列や動的どうてき配列と言います。

公式リファレンス↓貼っておきますね。動的・静的それぞれ載ってます。

ソースの続きとしましては、あとはもう各要素に値を入れていくだけです。

    colors(0) = 192

これ↑ですね。これを

    colors(110) = 192

こんな風にして許容されていない場所に値を入れようとするとどうなるか、というと・・・

配列のとあるインデックスの要素に値を代入しようとしたときのエラー

こんなエラーが発生します。その添え字には箱は用意されてないよ！と怒られます。「colors(0) = 192」←こういうソースの「(0)」の数字の部分を添え字やインデックスと言う、と配列初出の#10でも説明しましたね。

また、同じく#10で添え字は0から始まるから注意して！という話をしたのですが、どうやら0からにするのか1からにするのか指定できるオプションがVBAには用意されているようです。

上記に貼った公式リファレンスから一部キャプチャ

実を言うと、0か1だけでなく好きな数字から始められる方法があるのですが、それは#16でレクチャーします。


もうひとつ。次元じげんについて話をさせてください。

まずプログラミングとか一切関係なしの一般的な「次元」という言葉は空間を表すときに用いられますが、これはその次元です。

ここ↑がわかりやすいかな。プログラミングは関係のないサイト。純粋に「次元」について説いてます。

配列は厳密には1次元配列とか2次元配列など「n次元配列」という言い方をします。n次元って言ったけどほとんどのケースで1か2までです。

この次元を図示すると・・・

1次元配列と2次元配列を図示したもの

こんなイメージです。1次元配列は1方向にのみ要素を保持しますが、2次元配列になると2方向で保持します。プログラミング上で扱うときはちょっと複雑になりますが、使用頻度はままあります。

2次元配列は#15で扱うのでお楽しみに。


実際の実装時にWithを書くタイミング

今回の実装で当然のようにWithステートメントを使っているじゃないですか。それ自体はいいのですが、実装を進めるときの順序として誤解いただきたくないな、という想いがあるのでそれだけ伝えさせてください。

私の場合はですが、Withステートメントを利用するのは実装の終盤です。ソースコードを組んで、動作確認をして、いよいよ完成か、というときにソースコードを綺麗にするステップがあるんですね。

システムの動作を変えずにソースコードを綺麗にすることをリファクタリングと言います。このリファクタリングの段階で初めて「あ！ここ変数○○多用してんじゃん！With使えるじゃん！」となって利用します。

この連載では先に完成してるソースコードがあるので、実装中盤で当然のようにWithステートメントを使っていますが、実際に地道に実装を進めるときはそんなスマートな振る舞いはしていないんよ、ということです。

念のためのお伝えでした。実装中盤で「With使えますやん」ってなればそれはそれで使ってOKですからね


無限ループの注意

今回、本編中で無限ループをやりましたが、そのとき

これ、あなたの方でもやる前に念のため[Ctrl] + [S]キーで保存してください。そして、実行前に私がやる様子を見てください。

と言って、やたら慎重になっているじゃないですか。

これには訳がありましてですね、処理内容にもよるのですが、無限ループを動かしたときってコンピュータの内部でメモリが不当に食われすぎてアプリがフリーズしたり強制終了したりすることがあるんです。

だから実装がまだおぼつかない段階で動作を見るときは必ずその前に保存する癖をつけてください。せっかくコーディングを進めたのに強制終了ですべて水の泡になったら台無しですからね。

これで痛い目見たことも数知れず・・・泣　世の中のプログラマたちよ・・


宿題の大ヒント

本編の最後にあみだくじの2つめの実装を各自で完成させてほしい、という宿題を出しました。

まずは自分で考えたい、という方はこの項はスルーしてください。

全然見当がつかないよ、という方のためにヒントです。

大部分はあみだくじ1のロジックを流用しておりまして、下記までは同じです（下記はWith~End Withを使用していません（使ってもいいよ））。

Sub J_あみだくじ2()

    Call init
    
    If tryLotIndex = 0 Then
        Exit Sub
    End If
    
    '塗り替える色の取得
    Dim colors() As Long: colors = getColors()
    repaintColor = colors(tryLotIndex - 1)

    'あみだくじ進行を続けるかどうかのフラグ
    Dim isContinue As Boolean: isContinue = True
    
    Do
        '1セル進む
        tryLotRange.Select
        tryLotRange.Interior.Color = repaintColor
        
        If tryLotRange.Offset(0, 1).Interior.Color <> NO_COLOR  Then
            '右へ移動
            Set tryLotRange = tryLotRange.Offset(0, 1)
        ElseIf tryLotRange.Offset(0, -1).Interior.Color <> NO_COLOR Then
            '左へ移動
            Set tryLotRange = tryLotRange.Offset(0, -1)
        ElseIf tryLotRange.Offset(1, 0).Interior.Color <> NO_COLOR Then
            '下へ移動
            Set tryLotRange = tryLotRange.Offset(1, 0)
        Else
            '移動先がないので処理を終了する
            isContinue = False
        End If

        Application.Wait [Now() + "0:00:00.001"]
        
    Loop While isContinue

End Sub

上記ソースになにかしら手を加えることで

  • 複数回実行しても同じ動作をする

  • 上方向の進行も可能とする

この2点を実現してください。


おわりに

今回もありがとうございました！

私としては第一章もいよいよ佳境だ、という想いです。

毎回もう少しライトな仕上がりにしたいのですが、伝えたいことが多くてどうしてもハードな感じになってしまいます。

記事冒頭の目次を見た瞬間に「うっ・・」となってる方もいるかもしれませんね。てか私ならなります。

でもここまで続けられてるの、すごいですよね。ご自身の粘り強さや果敢な姿勢を誇ってください。間違いなく進歩しています。

今回は宿題をお出ししているので、ちょ～っとだけ考えてみてください。「途中でいやになってしまう」というのが最も避けたいことですから、早々にギブアップしても大丈夫ですよ。

余談だけど、いいロジックとか問題解決の糸口ってお風呂入ってるときとか皿洗ってるときに思いつくことが多いです笑。だから気分転換もしてね。

では、次回へつづく！（今回もありがとうございました）


この記事が気に入ったらサポートをしてみませんか？