ワークシート上のフォームコントロールはどうやって取得する?【VBA】
最近書いた「サクラクレパスクーピーの柄をランダムに生成するExcelマクロを考えてみた」の続きです。ワークシート上でフォームコントロールの図形を扱っていたときに少し引っかかった話です。
フォームコントロールのボタンが消えてしまった
このクーピー柄生成マクロを作っている際に、シート上に生成した図形をすべて消すため、以下のマクロを書きました。
見ておわかりの通り、アクティブなシート上に存在する図形をすべて消去するマクロです。このマクロをフォームコントロールのボタンに登録し、そのあとボタンを押して実行したのですが、
押したボタンまで消えてしまった……
まあ「そんなの当たり前だろ」って話なのですが、Shapeオブジェクト=オートシェイプくらいの認識しかなかった私は、このとき初めて「フォームコントロールもShapeオブジェクトに含まれるのか…」と思ったわけです。
ではフォームコントロールをどうプログラムに識別させる?
というわけで、deleteメソッドで図形のうちボタンだけを消去せずに残す対策を考えることに。Shapeオブジェクトのプロパティの中に、必ずフォームコントロールであることを指定するプロパティがあるはずなので、それを探すことにしました。
繰り返しますが、私の中でShapeオブジェクトはオートシェイプのイメージしかなかったので、当初このフォームコントロールを探すのに、AutoShapeTypeプロパティのどれに該当するのかなーという発想になり、それを探してました。ちなみに以下が公式リファレンスです。
当然、該当するものは見つかりません…
フォームコントロールはTypeプロパティで指定する
その後、ある人のブログを見てようやく判明。Shapeオブジェクトには、Typeプロパティというのがあって、そこでAutoShape以外のShape(例えば画像とかフォームコントロールとかテキストボックスとか)の種類を指定できるのですね。ちなみに以下が公式リファレンスです。
今回探していたフォームコントロールはmsoFormControlでと書くようです。というわけで最初に紹介したマクロは以下のように修正するのがよいでしょう。
こうすれば、ボタンは消去されません。あと今回のクーピー柄生成マクロでは、柄の上にクーピーの商品名が書いてある画像ファイルを貼り付けてあり、それも消去の対象から外したいので、それも上記コード中に書いてあります。画像はmsoPictureというType名です。
まぁ「オートシェイプだけを消す」という目的なら
If shp.type = msoautoshape
と書いて、「オートシェイプに該当したら消去」というロジックでもいいんですけどね。
以上、Shapeオブジェクト=オートシェイプと恥ずかしい思い込みをしていた私のちょっとした失敗談でした。
JavaScriptでポーカーの役を判定するプログラムを書いてみた
タイトルの通り、ポーカーの役を判定するプログラムをJavaScriptで考えてみました。実はこのネタは、以前このブログでExcel VBAバージョンで書いたのですが、JavaScriptでは別の書き方ができるのではと思い実験してみました。
実際のプログラムは以下の通り
実際書いてみたプログラムは以下です。
このプログラムでは、成立した役名の文字列を返すようにしています。上記のサンプルコードだとストレートが成立するので、関数を実行すると、”Straight”という文字列が返るようになっています。以下、手順と要点です。
手札の数字とスーツを配列に格納
本来ならランダムに生成させるのですが、上記のコード内では取り急ぎ決め打ちで入れています。スーツと数字を二次元配列で管理しています。ここはVBAと違って本当に楽ですね~。
手札を昇順にソートする
役を判定するにはまず手札をソートする必要がありますが、JavaScriptには標準でソートのメソッドがあるので非常に楽です。これを知ったときはちょっと感動しました(当然ながらVBAでは用意されていないので。なので誰かがWebに上げてたクイックソートをコピペして使いました)
といいつつ、私はまだこのSortメソッドの使い方を知らず、以下の記事をみてコピペしただけですので、まぁまた必要なときに勉強します・・・
最初にフラッシュとストレートを判定するフラグを立てる
フラッシュやストレートを判定するロジックをif文の条件式の中に組み込んでもよいのですが、そうすると煩雑になりそうなので、
isFlush
isStraight
isRoyalStraight
などの変数を設け、フラッシュやストレートが成立するかを予め格納しておきました。
フラッシュ、ストレート以外の 判定
ここはVBA編で書いたものと同じロジックですので詳しくはVBA編を参照してください。当初、JavaScriptで別の書き方がないかなぁと思って探し、一応候補になるものはあったのですが、そんなに記述量を減らせるわけではなさそうだったので、以前書いたものに落ち着きました。
以上です。フラッシュとストレート以外の判定の部分、もっと短く書けるスマートな書き方はないものだろうか。
サクラクレパスクーピーの柄をランダムに生成するExcelマクロを考えてみた
おそらく誰もが触ったことのあるサクラクレパス社のクレヨンのクーピー。カラフルな柄のパッケージデザインでおなじみですが、これをExcelで自動生成するというくだらないマクロを考えたので、その過程を書いてみたいと思います。
どんなExcelマクロ?
先日ツイートした以下の内容をご覧ください。文字通り、Excelの図形オブジェクトを使ってクーピーの模様っぽいものをランダムに生成するというしょーもないマクロです。
サクラクレパスのクーピーの模様をランダムに生成するマジでどうでもいいマクロが完成しました。#Excel #VBA #マクロ pic.twitter.com/vvbroNhTRQ
— (有) (@tdyu05) September 10, 2019
ちなみに、正式な模様は以下です。
見ての通り、実際はもっと鮮やかでちゃんと練られているデザインですね。
なぜ作ったのか?
ぶっちゃけ特に意味はありません。4歳になる息子がよくお絵かきをするのにクーピーを使っているのですが、そのパッケージを何気なくを見ていたときに、「これ、柄のパターンに法則がある!プログラミングで生成できるかも!?」とふと思ったのがきっかけです。
というわけで、生成する要件を考えてみる
パターンに法則がある、というふうに書きましたが、正確には生成するロジックがある程度決まっているということですね。ざっと見たとき、以下のことが言えそうです。
よし、これなら簡単そうだ。というわけでVBAで作ってみました。
作り方
最後にソースコードは載せますので、ここではポイントだけ載せておきます。
図形描画のために必要な変数をセット
基本ですが変数を以下のように定義しました。leftPositionは図形の左端の位置。topPositionは図形の上端の位置です。
図形に色を当てるための関数を用意しておく
図形にはランダムに色を付ける必要があるのでそのために以下の関数を作りました。ランダムにR、G、Bの値を生成し、それを配列として返すようにします。
Function createRGB() As Variant Dim r As Integer, g As Integer, b As Integer Dim arr As Variant Randomize r = Int(Rnd * 256) g = Int(Rnd * 256) b = Int(Rnd * 256) arr = Array(r, g, b) createRGB = arr End Function
縦に並んだ2つの棒を作る
以下の通りです。図形を生成するのは、ShapesオブジェクトのAddShapeメソッドです。引数は、1:図形の種類、2:最左端の位置、3:最上端の位置、4:幅、5:高さです。最後に先程生成した色をFillプロパティで適用します。
'//RGB値を取得 arr = createRGB '//上の棒を生成(※jはループのためのカウンタです) Set s = ActiveSheet.Shapes.AddShape(Type:=msoShapeRectangle, Left:=leftPosition + (j * lineWidth), Top:=topPosition, Width:=lineWidth, Height:=upperHeight) '//線はオフ s.Line.Visible = msoFalse '//取得した色を当てはめる s.Fill.ForeColor.RGB = RGB(arr(0), arr(1), arr(2)) '//以下は下の棒を生成するもの。上とほぼ同じなので省略 arr2 = createRGB Set s2 = ActiveSheet.Shapes.AddShape(Type:=msoShapeRectangle, Left:=leftPosition + (j * lineWidth), _Top:=topPosition + upperHeight, Width:=lineWidth, Height:=lowerHeight) s2.Line.Visible = msoFalse s2.Fill.ForeColor.RGB = RGB(arr2(0), arr2(1), arr2(2))
上下の2つの棒を区切るサブ図形を生成する
上下にある2つの棒を区切る小さな図形(サブ図形:丸と三角形と四角形)を生成します。これは違うプロシージャ(createSubShape)に書いたので、メインのプロシージャから、引数とともにCallで呼び出します。サブ図形の種類については、ランダムな数字を生成してそれを渡します。本マクロでは0:丸、1:三角形、2:四角形です。
Call createSubShape(leftPosition2, upperHeight, n) '//第1引数:左端の位置、第2引数:上の棒の長さ、第3引数:図形の種類
サブ図形についての生成については、AddShapeメソッドで図形を生成し、引数で図形の種類、上端の位置、図形の高さを決めて、色を塗って・・・とやることは一緒なので省略します。少しだけ計算が面倒だったのが正三角形の上端の位置の算出です。参考までに以下に書いておきます。
ちなみに、このクーピーの模様では三角形が逆向きになることもあります。これもランダムに発生させます。そのために、まずランダムな数字(0か1)を生成させ、もし0が出たら図形をひっくり返すという風にしています。図形をひっくり返すには、ShapeオブジェクトのFlipメソッドを用い、引数を msoFlipVerticalにします。
どんな図形ができたか!?
上記の図形生成を、Forループで左端の位置をずらしながら実行しました。そうすると以下のような模様ができ上がります。さあどうだ!!
えっ・・・なんか微妙・・・・
なんか不自然ですね・・・これでは本家本元のかわいらしいクーピーの模様に到底及びません!!
ということで改善方法を考えてみました。
何がおかしいのか?
図形の位置や色を一切の条件なしにランダム生成すると変な模様ができてしまうので、原因を考え、ある程度ランダム化に制限を設けることにしました。その制限が以下のものです。
確かに、クーピーの模様をよく見てみると、
①上の棒と下の棒の長さ関係は列ごとによって結構ばらついている
②サブ図形は同じものが隣り合っていない
③地味な色が少ない
ということがわかります。というわけで①に関しては、前回の列の長さを記憶してそれと比較し、サブ図形の高さの1.5倍分以上は離れるようにしました。②に関しても前回の図形と比較して、同じ図形が出ないようにすればOKです。
残る③の地味な色避ける方法ですが、これを厳密に調整するのは困難なので、「最低限、無彩色に近い色(白、黒、灰色)は避ける」という方向にしました(※ただ実際の模様には、黒っぽい無彩色はあるみたいですけど)
ちなみに無彩色に近い色というのは、簡単にいうとR、G、B各数値が同じような値の色です。例えばRGB(100,110,102)とかで色を調べてみてください。緑味の灰色で地味な色ができます。
今回、完全に地味な色は排除しきれないものの、取り急ぎ以下のロジックを作りました。
(1)R、G、Bの各数値をランダムに生成する
(2)RとG、GとB、BとRの各数値の差の絶対値を調べる
(3)それら3つの絶対値を全部足して90以下だったら、R、G、Bのどれか1つをランダムに選んで数値を100上げるor下げる
こうすれば明らかに白、黒、灰色っぽい色は生成されなくなります。
でき上がり!
この設定変更を加えたマクロを実行すると、例えば以下のような図形が生成されます。どうでしょうか!?先程よりはだいぶ良くなったでしょうか!?
正直なところ、本家本元のデザインには全然及びませんが、まぁ最初よりはマシになったといえるでしょう。
ただ、このマクロはまだ難点が残っており、上の棒と下の棒、または棒とサブ図形、または列同士で似たような色相の色が隣り合ってしまいます。
これはR、G、Bの中で最も数値が高い色を調べることで、似たような色相が隣にできてしまうことは回避できるのですが、もうめんどくさいのでこれはやりませんでした。
というわけで以上、全く実用性のないお遊びマクロの解説でした。最後に、今回作成したマクロのソースコードを以下に載せておきます。以下のコードをコピペしてdrawプロシージャを実行すれば動くはずです。
Excel VBAでポーカーの役を判定するプログラムを書いてみた
以前、Excel VBAとExcelのワークシートを使い、ゲームセンターによく置いてある「ビデオポーカー」を再現してみました。それについては後々このブログで書きたいなと思いますが、その前にポーカーのプログラムを作成する上で最も重要な「役を判定する」部分をどう作ったのかを紹介したいと思います。
はじめに
作ったきっかけは私がゲームセンターのポーカーが好きだったから。プログラミングの勉強の一環として作ってみたいなと思いました。ポーカーの役を判定するアルゴリズムを以前ネットで調べてみたのですが、自分が使える言語での解説はなく読み解くのも大変なので、完成度はどうあれ自分で作ってみることにしました。
役を判定する方法の概要
初心者なりに私が考えた方法は以下です。
- まず重複させないように、ランダムに「数字+絵柄」の組み合わせを5つ作る(手札は5枚だから)
- 5枚の数字だけを格納する1次元配列を作る・・・(A)
- 5枚の絵柄を格納する1次元配列を作る・・・(B)
- (A)の配列をソートして昇順に並び替えておく
- (B)を用いて、まずフラッシュが成立するかを判定する
- フラッシュが成立すれば、ロイヤルフラッシュかストレートフラッシュか、フラッシュかを判定する
- フラッシュが成立しなければその他を判定する
ポーカーに限らず、そもそもトランプを使ったゲームのプログラムを作るとき「数字」と「絵柄(スート)」の2つの情報をどう管理するのかベストなのかはいつも疑問に思っていました。数字とスートをまとめた2次元配列を作ればよいのかなと思っていたのですが、今回は数字と絵柄を違う配列にわけることにしました。
その理由はVBAだと2次元配列の操作や管理が面倒だから。多分ほかの言語でやるならこのように2つの配列には決して分割しないでしょうね。
数字の配列(A)と絵柄の配列(B)と2つの配列を作ると、Aの方だけソートしてBをソートしなければ、最初の手札の数字と絵柄の対応が崩れてしまうため、一見不便に思います。
ですが、実際に絵柄の配列の方はフラッシュが成り立つかどうか(=5枚の絵柄がすべて同じか)だけにしか使いませんし、実際ポーカー全体のプログラムを作る上でもこの実装方法でもまったく支障はありませんでした。
役を判定する方法の詳細な解説
実際に1つずつ見ていきます。
5つの「数字+絵柄」を作る方法
まず以下のような2次元配列を作っておきます。これで4×13の二次元配列すべてにTrueが入ります。
For i = 0 To 3 cardArray2(i) = Array(True, True, True, True, True, True, True, True, True, True, True, True, True) Next i
これは「数字+絵柄」の組み合わせをランダムに生成させたとき、一度生成したものをフラグオフしておくことで重複させないようにするための配列です。絵柄の順番はスペード、ハート、クローバー、ダイヤです。例えば、ランダムに数字と絵柄を生成し、スペードの1が出たらcardArray2(0)(0)をFalseに、ハートの2が出たらcardArray2(1)(1)をFalseにするというふうに操作します。
実際にランダムに数字と絵柄を生成するのは以下の処理です。
Do Until j = 5 n1 = Int(Rnd * 4) '//←ランダムに絵柄を生成(0:スペード/1:ハート/2:クローバー/3:ダイヤ) n2 = Int(Rnd * 13)'//←ランダムに数字を生成 If cardArray2(n1)(n2) = True Then cardArray2(n1)(n2) = False myHandN(j) = cardArray(n1)(n2) myHandS(j) = suitArray(n1) j = j + 1 End If Loop
これで、5つの数字の配列はmyHandNに格納され、5つの絵柄の配列はmyHandSに格納されます。
数字をソートして並び替える
配列をソートさせるにはソートアルゴリズムを使えばよいのですが、アルゴリズムを一切勉強していない私はその方法を知らないので、ここは先人の知恵を借りました。なんと幸いにもクイックソートをVBAで実装しているブログがありましたので、ここではそれをまるごとコピペして使わせてもらっています。ちなみに以下のブログです。
ソート後の処理
ソート済みの手札の数字の配列ができたら、その配列と絵柄の配列2つを引数に、今回私が考えたポーカーの役を判定する関数「checkPokerHands」関数に渡します。先にソースコードを記載しておきます。
渡された引数のarNが5つの数字の配列であり、arSが絵柄の配列です。関数の戻り値は数字にしています(ロイヤルフラッシュが出たら7、ストレートフラッシュがでたら5など)。
Function checkPokerHands(ByVal arN As Variant, ByVal arS As Variant) As Integer Dim num As Integer Dim a As Integer, b As Integer, c As Integer, d As Integer a = arN(4) - arN(3) b = arN(3) - arN(2) c = arN(2) - arN(1) d = arN(1) - arN(0) If arS(0) = arS(1) And arS(1) = arS(2) And arS(2) = arS(3) And arS(3) = arS(4) Then If arN(0) = 1 And arN(1) = 10 And arN(2) = 11 And arN(3) = 12 And arN(4) = 13 Then num = 7 '//ロイヤルフラッシュ ElseIf a = 1 And b = 1 And c = 1 And d = 1 Then num = 6 ' //ストレートフラッシュ Else num = 3 '//フラッシュ End If Else If a = 1 And b = 1 And c = 1 And d = 1 Then num = 2 '//ストレート ElseIf arN(0) = 1 And arN(1) = 10 And arN(2) = 11 And arN(3) = 12 And arN(4) = 13 Then num = 2 '//ロイヤルストレート Else '//以下4カード、フルハウス、3カード、2ペアを判定 '//(手札の中で同じ数字の組み合わせが見つかった回数で上記を判定) For maxNum = 3 To 0 Step -1 i = 3 - maxNum For j = 1 To 1 + maxNum If arN(i) = arN(i + j) Then cnt = cnt + 1 End If Next j Next maxNum Select Case cnt Case 6 num = 5 '//4カード Case 4 num = 4 '//フルハウス Case 3 num = 1 '//3カード Case 2 num = 0 '//2ペア Case Else num = -1 '//1ペアもしくはブタ End Select End If End If checkPokerHands = num End Function
まずはフラッシュかどうかを判定する
判定方法を解説します。まず上記では、絵柄の配列を使って、If文でフラッシュが成立するか否かを最初に判定しています。その後、数字が10,11,12,13,1だったらロイヤルフラッシュになります。もし手札の数字の1枚めと2枚め、2枚めと3枚目・・・というふうに隣同士の差を調べ、すべて1だったらストレートフラッシュ、それ以外ならただのフラッシュという判定を行っています。
フラッシュ以外を判定する
次にフラッシュ以外だった場合の処理です。まず先にストレートが成り立つかを判定します。これは先述の通り、手札内の各札の差が1ずつ並んでいるか、もしくは10,11,12,13,1(ロイヤルストレート)になればOKなので判定は簡単です。
もし上記が成り立たなかった場合、4カードかフルハウスか、3カードか2カードか、1ペアかブタを判定します。ここも私が思いついたのは、
「5枚の手札のうち2枚のカードが同じ数字になる数を数えて判断する」という方法です。その数を数えている部分が以下です。
For maxNum = 3 To 0 Step -1 i = 3 - maxNum For j = 1 To 1 + maxNum If arN(i) = arN(i + j) Then cnt = cnt + 1 End If Next j Next maxNum
例えば、1が4つそろった4カードとして
カードA:1
カードB:1
カードC:1
カードD:1
カードE:2
という手札があるとします。
このとき、カードA=カードB、カードA=カードC、カードA=カードD、カードB=カードC、カードC=カードD、というように同じ数字のペアが5つあるので、4カードの場合は「5」となります。
同じように、フルハウスは4、3カードは3、2カードは2、1ペアが1、ブタが0というように、偶然にもきれいに分かれるので、とても判定が楽です。ちなみに今回のポーカーのプログラムでは1ペアは役成立にみなしていないので、ブタと同じ扱いにしています。こうして役が判定されたらそれに応じて戻り値を設定します。
私が作ったポーカーのプログラムでは、戻り値を数字で欲しかったので、上記のサンプルもそうなっています。
最後に
以上、結構シンプルですね。最初「難しいんだろうなぁ・・」という先入観があったので二の足を踏んでいたのですが、案外すぐに作れました。まあクイックソートの部分は他の人のコードをそのまま作ったので、それを自分で書こうとしたらもっと時間がかかったかもしれません。肝心のExcelポーカーの方は、また別途ご紹介したいと思います。
JavaScriptで連想配列の中に連想配列を入れ子で入れる方法
JavaScriptを勉強しているとき、多次元配列を作る必要があり、いろいろと動作の実験をしてみました。ここでは自分用のメモとして以下のサンプルを作りました。連想配列を3つ重ねた3次元の配列です。
function test(){ myArray = new Array(); myArray = {ひらがな: {あ行:{a:"あ",i:"い",u:"う",e:"え",o:"お"}, か行:{a:"か",i:"き",u:"く",e:"け",o:"こ"} },カタカナ: {ア行:{a:"ア",i:"イ",u:"ウ",e:"エ",o:"オ"}, カ行:{a:"カ",i:"キ",u:"ク",e:"ケ",o:"コ"} } }; //配列の要素の呼び出し方は以下どちらでもよいようです。 alert(myArray["ひらがな"]["あ行"]["e"]); // ==> "え"が出力される alert(myArray.カタカナ.カ行.o); // ==> "コ"が出力される /*ちなみに、配列の要素を変数を用いて呼び出したい場合*/ var str1 = "ひらがな"; var str2 = "か行"; var str3 = "e"; alert(myArray[str1][str2][str3]); //==> "け"が出力される alert(myArray.str1.str2.str3); // ==>この呼び出し方はできませんでした }
調べていて、連想配列の要素を変数を用いて呼び出すやり方に謎を感じました。たとえば、以下の通常の配列の場合
array1 = ["あ","い","う","え","お"]
要素を取り出すときはarray1[0]のようにでくくって記述します。一方で、以下のように連想配列の場合
array2 = {a:"あ",i:"い",u:"う",e:"え",o:"お"}
要素を取り出すときは、array2.aのようにドットで記述しますし、通常の配列のようにarray2["a"]のような記述でも大丈夫です。
しかし!変数を使うときは以下のように、での記述しかダメ(?)みたいです。
var str1 = a;
array2 = {a:"あ",i:"い",u:"う",e:"え",o:"お"};
alert(array2[str1]);
//==>"あ"が出力される
素人の感覚からしたら、array2.str1って記述するのかなーと思いましたが違うのですね。不思議。ちなみに、自分のコーディングが間違ってるのか、多次元配列にするとき、通常の配列と連想配列の混在ってできないのだろうか・・動作しない・・
2次元配列を初期化する方法のメモ(VBAとJavaScript)
普段、Excel VBAとJavaScriptを趣味で使うことがあるのですが、要素が空の2次元配列を作っておく(=2次元配列を初期化する)ケースに何件か遭遇したので、今後のためにメモしておきます。
JavaScriptで要素が空の2次元配列を作る
おそらく以下でOKのはずです。要素数が10×10の2次元配列arrができるはず。
var x, y, xMax, yMax; yMax = 10; xMax = 10; var arr = new Array(yMax); for(y = 0; y < yMax; y++) { arr[y] = new Array(xMax); for(x = 0; x < xMax; x++) { arr[y][x] = ""; } }
Excel VBAで要素が空の2次元配列を作る
VBAを普通の使い方をしていると、2次元配列を作ることは非常にレアだと思いますが、私みたいにへんてこなツールを作っていると使うシーンがまれにあります。
以下、同様に10×10の空の要素が入っている2次元配列arができるはず。
Dim i As Integer, x As Integer, y As Integer, c As Integer Dim ar() As Variant x = 10 y = 10 ReDim ar(x) As Variant For i = 0 To x - 1 Dim a As Variant a = Array("") b = "" c = 0 Do Until c > y ReDim Preserve a(UBound(a) + 1) a(UBound(a)) = b c = c + 1 Loop ar(i) = a Next i
VBAはそもそも配列に関する機能が貧弱なので、かなり面倒くさいですね・・JavaScriptはなんて簡単なことか(それが普通)
Excel VBAでユーザーフォーム上にマインスイーパを作る方法
長年Windowsに搭載されてきたおなじみのゲーム「マインスイーパ」。VBAを使ってこれをExcelワークシート上で再現している情報はネットにいくつかありましたが、ユーザーフォームでやっている人は少なかったので、今回やってみました。その方法を紹介しようと思います。
マインスイーパの要件と気をつけるところ
ルールは説明するまでもないと思いますので、ここでは特に触れません。簡単な条件ですが、以下です。マスの数を可変にするのは難しいので今回は決め打ちで9マス×9マス、地雷は10個で固定。
- マスは9マス×9マス
- 地雷の数は10個
- 右クリックで旗を立てる機能はあり
作る上で一番難しいかったのは「地雷がなく、かつ数字でもないマスを開いたらそのマスの周りの全方向を調べて数字があるマスまで全部開く」という部分ですね。これはあとで解説します。
コードの解説
xlsmファイルはこちらにアップしており、ソースコードは記事の最後に書きますが、ポイントとなる部分だけ解説します。
マスの作成
当たり前ですが、まず以下のようにラベルオブジェクトでマスを作っていきます。
今回はラベルの名前は左上から右方向にL1、L2、L3・・・L81としました。フォームのオブジェクト名は「form」、クラスモジュールの名前は「class1」。それ前提で解説を進めていきます。
マスに地雷をセットする
UserForm_Initializeでゲームを始めるのに必要な処理を行います。その1つがラベルへの地雷のセットです。それを行っているのがソースコード中のmineSetプロシージャです。
地雷の場所は変数上で管理します。1から81までランダムな数字を生成してそれを地雷番号として、同じく1から81まで要素をもつ配列変数status()中の番号に対して、もし地雷番号と合致すれば数字の2を格納する処理を行います。
マスに数字をセットする
マインスイーパではマス上に、そのマスの周りに地雷がいくつあるかを示す数字が書いてあります。この情報を格納します。これもマスであるラベルオブジェクトには直接記入しません。1から81まで要素を持つlNum()という配列変数の要素それぞれに、セルに記載する地雷数の数字を格納していきます。
合わせて、先程の配列変数status()にも、地雷数を記入するラベルの番号には数字の1を格納していきます。
この配列変数status()は81個のラベルが、「地雷のラベルか」「数字のラベルか」「何も記入のないラベルか」を判断するためのものです。
どうやってマスの周りの地雷数を数えているか
次に、81個のマスに対してループをかけて地雷数を記入するわけですが、マスをi番とするとその周りの8方向(i - 10, i - 9, i - 8, i - 1, i + 1, i + 8, i + 9, i + 10)のstatusを調べて、それが数字2だったら地雷がある、という判定を行います。
ただ、当然のことながらすべてのマスに対して「8方向を調べる」というロジックは使えません。例えば左上の端のマスは「左、左下、下」の3方向を調べるだけです。
あとから知ったのですが、これを回避するために、端のマスの外にも実際には使わないダミーのマスを設けるという手法があったのですが、このときはそれを知らなかったので、違う方法で行いました。
それが、例えばマスが四隅(マス1、マス9、マス72、マス81)のときは周り3方向を調べ、上端のマスのときは上を除く5方向を調べ・・・というように、探索するマスの方向をselect caseで条件に応じて変えるという地味な手段です。
クリックイベント処理を共通化する
今回は81個のマスがあり、クリックしたら開くというどれも同じ処理を行います。これをどう実装すればよいでしょうか。単純な方法として、以下の画像のようにラベルのクリックイベントを81個分書くという選択肢もあります。
ですが、同じことを何度も書くのでコードとしてはかっこ悪いですね。実はこの煩雑さを解消する方法があるのです。
クラスモジュールとWithEventsというキーワードを使うことで、複数のオブジェクトのイベントを1つのイベントプロシージャに集約できるのです。解説は多く出回っていますが、私が参考にしたのは以下の記事です。
私もいまいち掴みきれていないのですが、私が作ったソースコードを例に、イベント処理を一括化する方法というか理屈を以下に見てみましょう(説明が適切かは不明)
(1)WithEventsキーワードでラベルオブジェクト型の変数myLblを宣言する。
ソースコード内にあるlblSetというプロシージャで、その変数myLblにラベルオブジェクトのインスタンスを突っ込んでいくための処理を書きます(クラスモジュール内の以下の処理)
Public Sub lblSet(ByVal obj As MSForms.Label)
Set myLbl = obj
End Sub
(2)81個分のインスタンスを作る
当然のことながら実際にラベル81個分のインスタンスを変数に入れるには、まずインスタンス作って上記のlblSetを実行することが必要になります。これは、UserForm_Initialize()のプロシージャに書いてあった以下の部分です。
For i = 1 To 81
lblArray(i).lblSet Controls("L" & i)
Next i
※上記3行以外にごちゃごちゃ他の記述もありますが、シンプルにするため上記3行だけあえて抜き出しています。
(3)クラスの宣言をしておく
もちろん、その前にクラスを宣言する必要があるので、ユーザーフォームでも標準モジュールどちらでも良いと思いますが、以下を宣言しておきます。
Public lblArray(1 To 81) As New class1
こうすることで、81個のラベルオブジェクトは、すべてmyLblというオブジェクトになり、クリックとかマウスオーバーとか、ラベルオブジェクトに対してVBAで用意されているイベント処理が適用されるのです。ソースコードでは以下の部分です。
Private Sub myLbl_Click()
Call openLbl(myLbl)
End Sub
私もうまく説明できないので最初に示したリンクを参照されると良いと思います。
マスをクリックしたときの処理
さて、このプログラムで一番厄介なところです。マスをクリックしたらそのマスを開き、もし地雷だったらゲームオーバー、数字だったらマスに数字を記入、もし空欄だったら数字を開くまで隣のマスを探索し続けます。
この中で一番難しいのは、「クリックしたら空欄である限りその隣も開き続ける」という処理です。これは、openLblというプロシージャを一定の条件(=数字が書いてあるマスを開くこと、また開いたマスが端のマスであること)まで再帰処理させることで実現します。
加えて、全方位に調べるということなので、openLblプロシージャ内に、左上、上、右上、左、右、左下、下、右下の8種類のCall OpenLbl()があり、その引数にはそれぞれが向かう方向のラベルオブジェクトを取ります。
一例として、今クリックしたラベルの番号を仮に変数nとおくと、例えば左上への探索だったらCall openLbl(form.Controls("L" & n- 10))という感じですね。
マスを開き続ける再帰処理をどう止めるか
例えばマスをクリックしてどんどん開き続けたとき、もし左上方向への再帰処理であれば、上端のマス(=L1、L2、L3、L4、L5、L6、L7、L8)を開かれたら処理を止める必要があります。もちろん、8方向それぞれに対して止めるトリガーとなる終端のマスは異なります。そこで、私はarr()という配列変数を8個作り、それぞれの方向への再帰処理を止めるマス番号を格納しました。
要するに、左上方向への再帰処理は、arr(0)内のいずれかのマスに来たら処理終了、上方向への再帰処理はarr(1)内のいずれかのマスに来たら終了、というやり方です。
右クリックで旗を置く
マインスイーパには右クリックで目印の旗を置く機能があります。旗の絵を置くのが面倒なので、?のマークを置くことにしました。最初このマインスイーパを作ったとき、VBAでフォーム上で右クリックイベントができることを知らなかったので、この機能はつけていませんでしたが、調べてみたら方法があるらしいので最近実装しました。
それがソースコード内でいう、myLbl_MouseDownのイベントプロシージャです。ほぼコピペベースでやったので詳しいことはわかりませんが、どうやらButtonという引数にクリックされたボタンが渡されるらしいです。ちなみに右クリックするとButtonには2の数字が渡されます。それ以外の引数についてはよくわかりません。
そんな感じでなんとかでき上がりました。以下プレイ動画です(私は全然うまくないので、結構時間かかっています・・・)
ソースコード
以下、ソースコードです。
'-----------------------------------------------------------------------' ' 標準モジュール '-----------------------------------------------------------------------' Public lightColor As Variant Public darkColor As Variant Public blackColor As Variant Public status(1 To 81) As Integer '//ラベルの状態:0=数字なし、1=数字あり、2=地雷あり Public LNum(1 To 81) As Integer '//各81枚のラベルに記載する数字を格納 Public lblCount As Integer Public lblArray(1 To 81) As New class1 Public gameOverFlg As Boolean Sub startGame() form.Show End Sub '-----------------------------------------------------------------------' ' ユーザーフォーム '-----------------------------------------------------------------------' Private Sub UserForm_Initialize() Dim i As Integer, j As Integer gameOverFlg = False lightColor = RGB(200, 200, 200) darkColor = RGB(160, 160, 160) blackColor = RGB(0, 0, 0) lblCount = 0 For i = 1 To 81 With form.Controls("L" & i) .ForeColor = darkColor .BackColor = darkColor .Caption = "" End With status(i) = 0 LNum(i) = 0 lblArray(i).lblSet Controls("L" & i) Next i Call mineSet '//爆弾をセットする Call numberSet '//数字をセットする End Sub Private Sub CommandButton1_Click() UserForm_Initialize End Sub Private Sub mineSet() '//ラベルに地雷をセット Dim cnt As Integer Dim num As Long cnt = 0 Randomize Do Do num = Int(Rnd * 81) + 1 If status(num) <> 2 Then status(num) = 2 cnt = cnt + 1 If cnt = 10 Then Exit Sub Exit Do End If Loop Loop End Sub Sub numberSet() Dim i As Integer, j As Integer Dim arr As Variant Dim arrLength As Integer Dim mineCnt As Integer For i = 1 To 81 mineCnt = 0 Select Case i Case 1, 9, 73, 81 Select Case i Case 1 arr = Array(2, 10, 11) Case 9 arr = Array(8, 17, 18) Case 73 arr = Array(64, 65, 74) Case 81 arr = Array(71, 72, 80) End Select Case 2 To 8 arr = Array(i - 1, i + 1, i + 8, i + 9, i + 10) Case 74 To 80 arr = Array(i - 10, i - 9, i - 8, i - 1, i + 1) Case 10, 19, 28, 37, 46, 55, 64 arr = Array(i - 9, i - 8, i + 1, i + 9, i + 10) Case 18, 27, 36, 45, 54, 63, 72 arr = Array(i - 10, i - 9, i - 1, i + 8, i + 9) Case Else arr = Array(i - 10, i - 9, i - 8, i - 1, i + 1, i + 8, i + 9, i + 10) End Select arrLength = UBound(arr) '//1マスごとに周囲にいくつ地雷があるかを数える For j = 0 To arrLength If status(arr(j)) = 2 Then mineCnt = mineCnt + 1 End If Next j '//地雷の数が1以上ならマスに記入 If mineCnt > 0 And status(i) <> 2 Then status(i) = 1 LNum(i) = mineCnt End If Next i End Sub '-----------------------------------------------------------------------' ' クラスモジュール '-----------------------------------------------------------------------' Private WithEvents myLbl As MSForms.Label Public Sub lblSet(ByVal obj As MSForms.Label) Set myLbl = obj End Sub Private Sub myLbl_Click() Call openLbl(myLbl) End Sub Private Sub myLbl_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) If Not myLbl.BackColor = darkColor Then Exit Sub If Button = 2 Then If myLbl.Caption = "" Then myLbl.Caption = "?" Else myLbl.Caption = "" End If myLbl.ForeColor = blackColor End If End Sub Private Sub openLbl(clickedLbl As MSForms.Label) Dim x As Integer Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer, o As Integer, p As Integer, q As Integer Dim lblNum As Integer Dim arr(7) As Variant Dim stopFlg(7) As Boolean Dim opendLblNum As Integer '//クリックしたラベルの番号だけを取得 lblNum = Mid(clickedLbl.Name, 2, Len(clickedLbl.Name) - 1) '//ラベルを開く再帰処理を止めるフラグを初期化 For x = 0 To 7 stopFlg(x) = False Next x '//ラベルを開く再帰処理を止めるための条件 arr(0) = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 19, 28, 37, 46, 55, 64, 73) '左上 arr(1) = Array(1, 2, 3, 4, 5, 6, 7, 8, 9) '上 arr(2) = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 18, 27, 36, 45, 54, 63, 72, 81) '右上 arr(3) = Array(1, 10, 19, 28, 37, 46, 55, 64, 73) '左 arr(4) = Array(9, 18, 27, 36, 45, 54, 63, 72, 81) '右 arr(5) = Array(1, 10, 19, 28, 37, 46, 55, 64, 73, 74, 75, 76, 77, 78, 79, 80, 81) '左下 arr(6) = Array(73, 74, 75, 76, 77, 78, 79, 80, 81) '下 arr(7) = Array(9, 18, 27, 36, 45, 54, 63, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81) '右下 If clickedLbl.BackColor = lightColor Or gameOverFlg = True Then '//すでにラベルが開いているかゲームオーバーになってる場合は何もしない Exit Sub Else '//ラベルを開く(=色を変える) clickedLbl.BackColor = lightColor If LNum(lblNum) <> 0 Then clickedLbl.Caption = LNum(lblNum) If clickedLbl.Caption = "?" Then clickedLbl.Caption = "" Call checkGameOver(lblNum) openedLblNum = countLbl End If '//ラベルの数字によって文字の色を変える(本当は8まで必要だが・・・) Select Case clickedLbl.Caption Case 1 clickedLbl.ForeColor = RGB(11, 49, 143) Case 2 clickedLbl.ForeColor = RGB(230, 0, 18) Case 3 clickedLbl.ForeColor = RGB(0, 154, 62) Case 4 clickedLbl.ForeColor = RGB(4, 29, 90) Case 5 clickedLbl.ForeColor = RGB(153, 0, 0) End Select '/* 以下、ラベルをクリックしたときそれが空欄である '/ (statusが0)限り隣のラベルを開き続ける再帰処理 */ If status(lblNum) = 0 Then '//左上 For i = 0 To UBound(arr(0)) If lblNum = arr(0)(i) Then stopFlg(0) = True Exit For End If Next i If stopFlg(0) = False Then Call openLbl(form.Controls("L" & lblNum - 10)) '//上 For j = 0 To UBound(arr(1)) If lblNum = arr(1)(j) Then stopFlg(1) = True Exit For End If Next j If stopFlg(1) = False Then Call openLbl(form.Controls("L" & lblNum - 9)) '//右上 For k = 0 To UBound(arr(2)) If lblNum = arr(2)(k) Then stopFlg(2) = True Exit For End If Next k If stopFlg(2) = False Then Call openLbl(form.Controls("L" & lblNum - 8)) '//左 For l = 0 To UBound(arr(3)) If lblNum = arr(3)(l) Then stopFlg(3) = True Exit For End If Next l If stopFlg(3) = False Then Call openLbl(form.Controls("L" & lblNum - 1)) '//右 For m = 0 To UBound(arr(4)) If lblNum = arr(4)(m) Then stopFlg(4) = True Exit For End If Next m If stopFlg(4) = False Then Call openLbl(form.Controls("L" & lblNum + 1)) '//左下 For o = 0 To UBound(arr(5)) If lblNum = arr(5)(o) Then stopFlg(5) = True Exit For End If Next o If stopFlg(5) = False Then Call openLbl(form.Controls("L" & lblNum + 8)) '//下 For p = 0 To UBound(arr(6)) If lblNum = arr(6)(p) Then stopFlg(6) = True Exit For End If Next p If stopFlg(6) = False Then Call openLbl(form.Controls("L" & lblNum + 9)) '//右下 For q = 0 To UBound(arr(7)) If lblNum = arr(7)(q) Then stopFlg(7) = True Exit For End If Next q If stopFlg(7) = False Then Call openLbl(form.Controls("L" & lblNum + 10)) End If If openedLblNum = 71 Then MsgBox "GAME CLEAR!!" gameOverFlg = True End If End Sub Private Sub checkGameOver(ByVal n As Integer) '地雷を開いてしまったときの挙動 Dim i As Integer If status(n) = 2 Then gameOverFlg = True If gameOverFlg = True Then For i = 1 To 81 With form.Controls("L" & i) .ForeColor = blackColor If status(i) = 2 Then .Caption = "*" .BackColor = RGB(255, 0, 0) Else If status(i) = 1 Then .Caption = LNum(i) End If .BackColor = lightColor End If End With Next i End If End Sub Function countLbl() As Integer lblCount = lblCount + 1 countLbl = lblCount End Function
VBA→JavaScriptと入っていった私が感じたこと
プログラミング言語に触ったきっかけ
私が多少でもコードを書いて何らかのプログラムを作ったことがあるのは、VBAとJavaScript(加えてGoogle Apps Script)だけです。
以前、単純作業が多い古臭い会社に勤めていたもので、そこでの業務効率化のためにVBAを始めていったらものすごくハマってしまい、その後プログラミングそのものに興味を持ち始めました。
業務で必要だったわけではありませんが、その後趣味としてオンラインで学習できるツールでJavaScriptの文法を勉強しました。JavaScriptをやろうと思ったきっかけはもう覚えていませんが、とりあえずなんでもいいからプログラミング言語というものを触ってみたいという好奇心と、ブラウザとメモ帳さえあればできるというわかりやすさだったでしょう。
このときが確か2013年か2014年。JavaScriptだけ覚えても意味がないのでHTMLとCSSの基礎中の基礎も勉強しました。そのとき使ったのがかの有名なProgateです。今や有名になりましたが、まだこのときはサービス最初期の頃でした。
JavaScriptの方は、Jeek CodeStudyという無料のオンライン学習サービスで勉強しました。おそらくこれは当時使った形では、現在もう残っていないかと思われます。
最初に作ったものはもはや覚えていませんが、じゃんけんのプログラム(グーチョキパーを2つ表示させ、その組み合わせで勝ち、負け、あいこの文字をブラウザ上に表示させる程度のもの。もちろんCSSなどは使っていない)を書いた記憶があります。おそらく少し勉強すれば小学生でも書けるようなものです。
そんなこんなで触り始めたのはもうだいぶ前ですが、継続的にプログラミングをしていたわけでなく途中一切やっていない時期も多かったので、2019年現在、私は対して上達してません。
JavaScriptに触って感じたこと
本題です。VBAの簡易なものと、それなりにしっかりしている言語であるJavaScriptの2つを触ってみて、当然ですが結構違いがあるなと思いました。JavaScriptの数%も理解していませんが、クソ素人目からみて私が感じる印象は以下です。
JavaScriptのforループの書き方に感動する
今でも毎回思うのですが、VBAのforループを書くとき
for i = 1 to 10
next i
のようにカウンタの変数が必要(←他の言語でもそうですが)になるわけですが、そのカウンタ変数をforループのために、forループの外に記入するのがどうも気になります。
そんな中
for(var i = 0; i < 10;i++){
}
カウンタ変数の宣言をforループの中に入れられる書き方には気持ちよさを感じました。
{}のかっこで挟めばよいのが楽
これもしょうもないことなのですが、VBAだとIfをEnd Ifで閉じたり、For LoopをNextで閉じたりするのもなんか好きではありません。無駄に行数とっているのと、あと結構閉じ忘れるのですよね。
配列に関するメソッドの豊富さに感動
JavaScriptをやっていてVBAのような言語と決定的に違うと思ったのが、配列の操作ですね。それはJavaScriptが充実しているのでなく、それがプログラミング言語の当たり前であって、VBAがなさすぎる。
ただ、それはVBAへの文句ではありません。VBAの場合はまともな使い方をしていれば配列の操作をあまり必要としないんですよね。セルに書き出した内容に対して操作を加えることが多いので、配列の変数上でごにょごにょしたりするケースは少ないように思います。私のようにVBAを使って変なプログラムや変なツールをつかっていると「配列のあの操作ができれば・・!」なんてしょっちゅう思うのですが、それはむしろ異端です。
VBAやJavaScriptから入ったことを振り返って
たまに、ネット界隈でプログラミング言語は何から始めたほうが良いかという話題が上がります。これはどの方も「自分がやりたい目的次第」と答えるでしょう。ただ、その中でたまにJavaScriptを推す人がいて、その理由は環境構築が一切不要だからです。ブラウザとメモ帳があればプログラムを書いて動かせるというのは本当にすごいと思います。
VBAもエクセルだけあればよいという意味で同様ですが、VBAの言語の目的はエクセル操作に関することが中心なので、業務でエクセルを頻繁に触っている人なら興味を持つでしょうが、そうでない人にはあまり響かないでしょう。
私自身は他のプログラミング言語を触ったことないので何から始めればよいかというのはさっぱりわかりませんが、VBAもJavaScriptも触っておいておかったなあと思います。コンパイルもいりませんので、自分の書いたコードすぐに何らかの形で結果としてすぐ動くというのは、それだけでとても嬉しいものでした。
程度はまったく大したものではありませんが、プログラミングはやっていて楽しいです。今からでもなりたいなぁといつも思っているくらいです。ただ、自分は書くのにも時間がかかり理解も遅くあまり向いてないと思うのでなれないでしょうけど。
でも趣味として今後ものんびりとちょっとしたプログラムを書いていこうかなと思います。(本職があまりにも多忙で趣味の時間が取れないというのが悩み)
Excelで作られた迷路を自動で解いて正答ルートを描画するマクロ
これは前回の以下の記事の続きです。
Excelのセルと罫で作られた迷路を自動で解くというプログラムをVBAで作ってみたところ、意外と反響が大きかったので、ここではどういう仕組みでそれを実現したのかを解説してみます。
Excel迷路を自動で解くとはどういうこと?
まず、本記事を最初に見られた方は「Excelで作られた迷路を自動で解く」については、以下のTwitterの動画をご覧ください。
激しい試行錯誤の末、セルと罫で作られたエクセル迷路の正解ルートを自動で描画する、最高にどうでもいいマクロが完成しました。
— (有) (@tdyu05) 2019年4月24日
#Excel #VBA #マクロ pic.twitter.com/iuvtYneYrR
この迷路は一番オーソドックスな迷路であり、正解ルートが1つだけしか存在しないものです。迷路によっては、途中で道と道がつながり合い、複数の正解ルートがあるものもありますが、今回はそのようなものではありません。
迷路の正解ルートを自動で描画するアルゴリズム
上記のマクロをTwitterで投稿したところ、迷路の生成も解答もどんな仕組みなのか、どんなアルゴリズムなのかを気にされる方が多くいらっしゃいました。
ただ、私はアルゴリズムありきで作ったわけでもなく、そもそもアルゴリズムも詳しくありません。なので結局のところアルゴリズムの名前はわかりませんが、ゴールにたどり着くロジックは以下の画面の通りです。
おわかりの通り、仕組みだけなら一切難しいことはしていません。道が分かれていたらまず進んでみて、行き止まりがあったら分岐まで戻って…これを繰り返せばいずれゴールにたどり着きます。少し調べたところ、このアルゴリズムは「深さ優先探索」というものかもしれません。
とはいえ、プログラマーではない私がこれをExcel VBAで作るのには本当に苦労し、正直めちゃくちゃ時間がかかりました。プログラミングやアルゴリズムがわかる方ならその何十分の1の時間で終わったでしょう。
単に迷路を解く(=ゴールの座標に到達する)ことはおそらく難しくはありませんが、やっかいだったのが今回作ったマクロの要件のもう1つ「正解のルートだけを色付けする」。これが本当に苦労しました。これは次の項で見ていきます。
正解のルートだけを色付けする方法
正解のルートに到達する方法を考える前に、まずはこのマクロでもっともやっかいな「正解のルートだけを色付けする」ロジックを考えてみましょう。
道を通るたびにInteriorプロパティでセルに色を付けて消してを繰り返していては、当然のごとく処理時間が遅くなるので、正解ルートの座標を1マスずつ配列にいれ、最後にまとめて色付けします。問題なのは途中の通路をどうやって配列にいれるかです。
分岐から分岐までの通路を複数の配列で管理する
迷路では、分岐してからの道がゴールに到達するかを探索しますが、もし間違った道に進めば行き止まりに達します。そのため、ある地点からは間違ったとしても、それ以前の正解だと確定しているルートを記憶しておく必要があります。それを実現するために私が考えたのは、例えば分岐Aから分岐Bまで、分岐Bから分岐Cまでなど、分岐間の通路の座標をすべて異なる配列変数に格納するという方法です。まず下記の画像を見てください。
分岐から分岐まで違う数字を記入した図です。上記の画像でいう通路0の3つのマスの座標をrouteArr(0)に入れておき、分岐してからの通路1の4つのマスの座標をRouteArr(1)に入れていくという方法です。
なお座標は、行をy、列をxとし、これをyyxxの文字列の形で上記配列に格納しています。セルオブジェクトの形で配列に入れられれば最後の描画で非常に楽だったのですが、VBAのArrayはオブジェクトをいれることができないための苦肉の策です。
よって上記の画像の迷路を例に取ると、通路履歴の配列には:
- routeArr(0) = (0101,0102,0202) ←0の通路
- routeArr(1) = (0203,0204,0205,0105) ←1の通路
- routeArr(2) = (0106,0206,0306,0406,0407,0408,0308) ←2の通路
という要素が入っていることになります。
こうすることで、例えば仮に最初の分岐から左に進んでrouteArr(1)に0201,0301,0302が入ったとします。もしその先が行き止まりになり、そこに入れた配列の要素をすべて消去し、最初の分岐を右に進んでrouteArr(1)を0203,0204,0205と入れ直したとしても、確定しているrouteArr(0)のルートは消されずに保たれる仕組みです。
なお、現在値を表すy、xについても、プログラム中では配列変数で管理しています。たとえば、上記画像の0の通路は、y(0)、x(0)、1の通路はy(0)、x(0)という具合です。
スタートからゴールまでの手順
それでは、ポイントをかいつまんでゴールにいくまでどのようなことをしているのかを紹介します。
現在地の周りの何方向に壁があるかを探索
まず、あるセル(座標)から、何方向に進めるかを検索します。後述のソースコードでは、getDirectionArrayという関数で求め、進める方向の数字をarr()という配列に格納しています。
ゴールに向かって進んでいく
上記の検索で、もし進める方向があれば、yまたはx座標を1つずらし、移動後の座標をrouteArr()に格納していきます。繰り返しになりますが、配列にいれるのは、最後の描画用に通路の履歴を残すためです。1方向しか進めない場合は、単純にその方向に座標を進め、そして再帰処理を行います。
もし分岐から2方向に進める場合は
この場合、進める方向の番号2つを配列のarr(0)、arr(1)に入れ、Forループでその2つの方向それぞれに再帰処理を行い進めていきます。その際に行っているのは、ループの2回目でその分岐からの座標の履歴の配列(=routeArr)を初期化することです。
上記Forループで分岐先1本目を進んで道を配列に格納しても、行き止まりに達したらその進んだ通路はもう不要になるからです。VBAでは配列要素を削除するメソッドがないので、とりあえず空の文字列要素100個を入れるということで初期化にしています。(100マスしかないので通路履歴のrouteArr(x)が100を超えることはありえないからです)
For xx = 0 To 100
routeArr(nm)(xx) = ""
Next xx
もし3方向に分岐がある場合は
実を言うと、このマクロはまだここが欠陥です。迷路生成では3方向に分岐するものはできないと勝手に思っていたのですが、どうやらまれにできてしまうようで、その際はこの解答マクロは動きません・・・動くように修正はできると思いますが、そこまでできていません。これは余力があったらやります。
もし行き止まりになったら
現在値の座標の周りが全部壁でどこにも進めない場合の処理はどうでしょうか。この場合2パターン可能性があります。もう一度以下の画像を見てください。
上記画像内の行き止まり1に達した場合、これは分岐3からのForループの1回目が行き止まりになったことを意味します。ですから通路の番号の変数を1つ下げ、分岐3の下の道を試行すればOKです(Forループの2回目)。
しかし、行き止まり2、行き止まり3も行き終わってしまったら今度は分岐3よりもっと前の分岐2まで戻る必要があります。
上記画像の場合、戻る先はたまたま2つ前でしたが、どの分岐点まで戻るかは分岐の深さによって迷路によって異なります。そのためどの分岐まで戻れるかを調べる必要があるのです。
これを調べる方法としては、本当はもっとよいやり方があるかもしれませんが、このマクロでは、新しいものから各分岐のセルの四方を調べ、そこに通過済みのフラグや壁がない方向が見つかったらそこに戻るという無難な処理で対処しています。それを調べる関数がcheckAround関数です。
ちなみに、過去の分岐に戻るのは、分岐2回目も行き止まりだった場合(=Forループ2回目)なので、Forループ2回目に入ったことを示すフラグ(backFlg)と、行き止まりに達した際に過去の分岐に戻るフラグ(stopFlg)を立てています。
ゴールしたら
この迷路では決め打ちで10マス×10マスの迷路で、ゴールも右下と決めているので、y()座標、x()座標がどちらも10になったら終了です。最後にrouteArr(0)~routeArr(5)に格納した配列要素をループにかけて該当セルを色付けしていきます。routeArrにはyyxxの形式で正解ルートの座標が1マスずつ入っていることを示すために、以下のGIF動画をご覧ください。正解ルートの色付けのほか、routeArr()の中身を書き出しています。
以上です。
ソースコード
以下ソースコードです。前回の記事で紹介した方法で迷路を作成したあと以下のコードを標準モジュールにコピペすればそのまま動くと思います。途中触れたように、3つに分かれる分岐がある迷路は動かない欠陥品です…何卒ご了承ください。
Excel VBAでワークシート上に迷路を自動生成するマクロ
くだらないExcelマクロを作るのが些細な趣味なのですが、この前軽い気持ちで作った「迷路を自動で生成して自動で正答ルートを色付けする」というマクロをTwitterで投稿したところ軽くバズりびっくりしました。せっかくなので、ここではその方法を紹介します。今回はまず「自動生成」のほうを紹介します。ソースコードは最後にあります。
「迷路を自動で生成して自動で正答ルートを色付けする」とは
まず、このマクロが何であるのかは、以下のツイート内の動画を見てもらえればわかると思います。
激しい試行錯誤の末、セルと罫で作られたエクセル迷路の正解ルートを自動で描画する、最高にどうでもいいマクロが完成しました。
— (有) (@tdyu05) 2019年4月24日
#Excel #VBA #マクロ pic.twitter.com/iuvtYneYrR
これは、Exceのセルを通路に、罫線を壁に見立てて、ランダムなルートの迷路を描画するマクロと、その迷路の正解ルートを自動で探索し描画するマクロの2つを実行したものです。
迷路を自動生成するアルゴリズム
決して大したものではないのですが、このツイートがバズったために「どうやって生成しているのか気になる」という類のコメントや、エンジニアや競技プログラミングをやられていると思わしき方からも「どんなアルゴリズムなのか」というコメントがちらほら寄せられました。
正直なところ、非プログラマーである私はアルゴリズムをまったく知らず、実際に皆様のコメントを見てから初めて、迷路生成/迷路解答アルゴリズムが存在するのだということを知ったくらいです。ですので、結局どの手法を使っているかわかりません。
生成のロジックは、おそらくいろんな方々が想像されるよりもかなりシンプルな仕組みです。以下の通りです。
(1)真っ白な10マス×10マスのセルを用意する
(2)開始地点として、一番左上のセルに通路を描画する
(3)現在地のセルの四方に通路ができているか否かを確認して、通路ができていない方向をランダムに選択しそのセルに通路を描画
(4)上記の(3)の処理を、四方が通路に囲まれて行き止まりになるか、またはゴールのセルの1つ手前に達するまで再帰処理でループさせる
まず、ここまでを動画にすると以下になります。イメージがつかみやすいでしょうか?
以下、続きです。
(5)既存の通路から新たに別の通路を開通させて上記の(3)~(4)の処理を再度行う
(6)上記(3)~(5)を繰り返し、10マス×10マスのセルをすべて埋めたら再帰処理のループを抜けて終了
(7)左上のセルの上部の罫線と右下のセルの下部の罫線を消して入り口出口を開通
以上です。アルゴリズムとしてはたったこれだけです。
ただ、非プログラマーの私としてはこれをどうやってExcelやVBAの中で実装するかが大変でした。(結果、ものすごく膨大な時間がかかってしまいました…)行数もたかだか220行程度です。本職の方がやればすぐ終わると思います。
Excel VBAで実装する方法
では、実際にVBAでどう作ったのかをポイントを紹介します。ソースコードについては、最後にすべて記すのでそちらを参照してください。まず先ほどの
「(3)現在地のセルの四方に通路ができているか否かを確認して、通路ができていない方向からランダムな方向を選択しそのセルを描画」の部分にふれてみます。
描画する前に、まず隣のセルに通路があるかを確認する方法
通路の判定はセル上のプロパティで行っていません。まず10×10のセルを2次元配列とみなし、配列変数にし、変数上で判定を行っています。デフォルトでは各座標の要素に0の値を入れておき、通路ができたらその座標の値を1にフラグオンします。
つまり、現在地の座標を基準に上下左右隣の座標が0ならその道を開通させる、というロジックです。
2次元配列の初期化
上述の2次元配列を初期化するためには次の記述を行います。下記の赤がy座標(=行)であり、青がx座標(=列)です。
arr(0) = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
arr(11) = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
Dim i As Integer
For i = 1 To 10
arr(i) = Array(1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1)
Next i
上記を見ると要素数はy座標12マス×x座標12マスとなっています。迷路のマスは10マス×10マスなので疑問に思うかもしれませんが、その理由は次の画像の通りです。2次元配列をセル上に可視化してみました。
あるセルから四方の配列要素の値が0か1かを判断するというロジックを使うといっても、壁側のセルの場合、壁の外を探索する必要ないので四方を調べる処理が使えません。しかし壁側セルだけに別の処理を書かせるとコードかなり煩雑になるので、壁側の外側にもy,x座標のマスを設けているのです。
隣のセルに通路を描画する
隣のセルに通路を描写するのは、後述のソースコード内に記載したfillRouteというプロシージャで行います。ただし、単純に道+壁を塗る処理だと以下のようになってしまうので、壁を開通させながら進まなければいけません。
進んだ方向からの壁を開通させるには、セルから次に進む方向を決めた後、自分がもともといた方向の数値を引数に取ってfillRouteプロシージャを呼び出します(ソースコード中「'//次に進む方向を決定」のコメント以下を参照)。進む方向と数字の対応は以下の通りです。
1:上方向
2:右方向
3:下方向
4:左方向
次に進んだ方向がわかれば自分がもともといた場所もわかります。
隣のセルに通路を描画する再起処理を止める条件は?
先ほどのステップ(4)で「四方が通路に囲まれて行き止まりになるか、またはゴールのセルの1つ手前に達するまで再帰処理でループさせる」という書きました。後者は例えば次の画像を見てください(ゴールのセルはK11。その手前のK10に来たのでストップしている)
(※今書いていて思い始めましたが、ゴールセル手前まで到達したら再起をストップという処理は迷路生成ロジックそのものとしては不要だったなと思い始める。別に手前まで止めずとともゴールセル上をそのまま描画しても多分迷路は作れますね・・)
行き止まり到達後、新たなセルから再び通路描画を始める
行き止まりに達したあと、次は任意のセルからまた通路生成を開始します。開始するセルを選ぶ処理は、正直妥協しました・・次に開通するセルは、「まだ通路が描画されていないセルを左上から検索していき最初にヒットした場所にする」という単純な条件で選択しています。先程の図でいうとH2のセルです(下図参照)
新たな通路描画の開始セルと既存の通路を開通させる
当然ですが、新たに生成した通路は既存の通路と開通させる必要があります。上記の画面でいえば、H2セルから始まった場合、G2セル側か、H3セル側の壁を開通させます。ソースコードを見てもらえればと思いますが、ここでは開通のために以下の処理をしています。
(1)配列direction()に壁がある方向の番号を格納
(2)関数getDirectionNumで、(1)で見つかった壁のうちどこに穴を開けるか、壁の方向(の番号)をランダムで取得
(3)その後、(2)で取得した開通先を引数に、最初に述べたfillRouteプロシージャで通路描画
これで行き止まりに達したらまた上記(1)~(3)を行います。10マス×10マスの迷路なので、通路を描画したセルが100個に到達したらExit Subしてマクロを終了します。
作ってみての感想
いま振り返りながら文書化してみると、もう少しシンプルに書けたり改良したりできたなと思うところはあります。特に行き止まりに達したあと、本来であれば新たに通路描画を開始するセルは以下の数だけ存在します(=既存の通路と接しているところ)
なので、「ランダムなx、y座標を生成させて、それが水色の部分に該当したらそこから描画を始める」という処理でもよかったかもしれません。
最後に1ステップずつ迷路を描画するGIF動画を置いておきます。今回迷路生成ロジックを説明しましたが、迷路を解くマクロは感覚的にその倍くらい苦労しました。これは次回解説します。
ソースコード
以下、今回の迷路生成マクロのソースコードです。多分標準モジュールにこのままコピペすれば使えるはずです。