t-hom’s diary

主にVBAネタを扱っているブログです。

VBAで脳トレ ~フラッシュ足し算を作ってみた

先日からこの本にトライしているのだが、、

Excel VBAでパズルを解こう

Excel VBAでパズルを解こう

17ページ~の汎用的な順列作成というのがどうも全体像を把握できない。
丸写ししたり、変数を好きな名前に変更しているうちに徐々につかめてきてはいるが、なんせ4重ループでそれぞれのループ変数がバラバラに動くので何をやっているのか把握するのがすごく難しい。

こういう困難な問題に対するアプローチはいくつかある。

一旦あきらめて他の問題に取り掛かる

他の問題を解いているうちに実力が付き、またこの問題に戻ってきた頃には解けるようになっているという寸法だ。

ひたすら写経する

解答のソースコードをひたすら丸写ししつづけて全体像を頭に叩き込むことで、何をやっているか把握する。

地道にトレースする

自分がコンパイラになったつもりで、1行ずつ変数の変化を追いかける。
王道だけど、やっているうちに頭から煙がでる。


しかし、色々考えているうちに、方法論ではなく、脳のワーキングメモリが追いついていないのが原因ではないかと思うようになった。
ワーキングメモリとは脳の前頭前野にある一時記憶領域のことだ。

たとえば電話番号を聞いてからすぐにダイアルする際などはこのワーキングメモリを使っている。

以下のようなやり取りに覚えはないだろうか。
Aさん「Bさん、電話番号おしえて!」
Bさん「090-1234-5678」
Aさん「090-…えーっと」
Bさん「1234」
Aさん「1234-…ごめん、もう一回言って。」

ワーキングメモリが衰えてくると、一度に沢山のことを処理しきれなくなる。

そして、ワーキングメモリは鍛えれば増えるらしい。

ということで前置きが長くなってしまったが、本題の脳トレである。
脳トレブームはすでに終わってしまった感もあるけれど、プログラムの処理が複雑になるとトレースできなくなるのは私にとって致命的なので、少しずつ取り組もうと思う。

まずは、ひと桁同士の足し算を作ってみることにした。
ひと桁ではあまりワーキングメモリを使わないのでトレーニング効果は薄いかもしれないが、まずはサンプルということでお披露目。

Sub フラッシュ足し算()
    Const タイムアップ秒 = 10
    時刻 = Timer
    Do While Timer - 時刻 < タイムアップ秒
        x = Int((9) * Rnd + 1)
        y = Int((9) * Rnd + 1)
        問題文 = "前回の結果:" & 結果 & vbNewLine & _
            "問題:" & x & "+" & y & "="
        結果 = IIf(InputBox(問題文) = x + y, "正解", "不正解")
        問題数 = 問題数 + 1
        If 結果 = "正解" Then 正解数 = 正解数 + 1
    Loop
    MsgBox "タイムアップ" & vbNewLine & vbNewLine & _
        "正解数:" & 正解数 & "/" & 問題数
End Sub

開始から10秒経過するまで問題を出し続け、タイムアップ時点で結果を表示する処理になっている。

※サンプルのため変数宣言は省略しているが、業務用のコードではマネしないように注意

トライしてみたところ、今日の最高記録は全問正解で8問だった。

さて、作ったは良いが、実際に使ってみると少々文字が小さすぎる。
f:id:t-hom:20150907233727p:plain
視力が落ちてきたので、3と8を見間違えて不正解になることもある。。

しかしvba標準機能ではInputBoxの文字サイズを変更できないようなので、ユーザーフォームで大きい文字のInputBoxを作ってみた。

f:id:t-hom:20150907235144p:plain

フォームのクラス名はInputBoxLargeFontFormとした。
フォームのコードはこちら

Private Sub UserForm_Initialize()
    TextBox1.SetFocus
End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Const ENTER = 13
    If KeyCode = ENTER Then
        Me.Hide
    End If
End Sub

Private Sub CommandButton1_Click()  'OKボタン
    Me.Hide
End Sub

Private Sub CommandButton2_Click()  'キャンセルボタン
    TextBox1.text = ""
    Me.Hide
End Sub

※実際はCommandButton1等のオブジェクト名はcmdOKなど適切な名称に変更しているが、このソースコード上では説明のためにデフォルトのままにしている。

そしてそれをInputBoxと同じように関数として扱うために、標準モジュールにInputBoxLargeFont関数を作成した。

Public Function InputBoxLargeFont(ByRef Prompt As Variant) As String
    With InputBoxLargeFontForm
        .TextBox1.text = ""
        .TextBox1.SetFocus
        .Label1.Caption = Prompt
        .Show
        InputBoxLargeFont = .TextBox1.text
    End With
End Function

InputBoxLargeFont関数ではTitleなどのオプション引数の処理は割愛している。
※引数PromptをあえてVariantで受けているのは、参照渡しでString型にしてしまうと呼び出し元が[Variant/String型]の場合に型不一致を起こすためである。

あとは単純にInputBox関数の代わりにInputBoxLargeFont関数を使うだけ。

Sub フラッシュ足し算()
    Const タイムアップ秒 = 10
    時刻 = Timer
    Do While Timer - 時刻 < タイムアップ秒
        x = Int((9) * Rnd + 1)
        y = Int((9) * Rnd + 1)
        問題文 = "前回の結果:" & 結果 & vbNewLine & _
            "問題:" & x & "+" & y & "="
        結果 = IIf(InputBoxLargeFont(問題文) = x + y, "正解", "不正解")
        問題数 = 問題数 + 1
        If 結果 = "正解" Then 正解数 = 正解数 + 1
    Loop
    MsgBox "タイムアップ" & vbNewLine & vbNewLine & _
        "正解数:" & 正解数 & "/" & 問題数
End Sub

さらに文字列の連結がやや見苦しいので、以前に以下の記事で紹介したCStyle関数を使ってみた。thom.hateblo.jp

Sub フラッシュ足し算()
    Const タイムアップ秒 = 10
    時刻 = Timer
    Do While Timer - 時刻 < タイムアップ秒
        x = Int((9) * Rnd + 1)
        y = Int((9) * Rnd + 1)
        問題文 = CStyle("前回の結果:%s\n問題:%s+%s=", 結果, x, y)
        結果 = IIf(InputBoxLargeFont(問題文) = x + y, "正解", "不正解")
        問題数 = 問題数 + 1
        If 結果 = "正解" Then 正解数 = 正解数 + 1
    Loop
    MsgBox CStyle("タイムアップ\n\n正解数:%s/%s", 正解数, 問題数)
End Sub

ランダムナンバーの取得処理も関数として外出ししておく。
ワークシート関数と同じ名前だが、VBAでやるほうが若干早い。
一応Randomize処理も入れておいた。

Function RandBetween(lowerbound As Variant, upperbound As Variant)
    Randomize
    RandBetween = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
End Function

以下はRandBetween関数を使ったコード

Sub フラッシュ足し算()
    Const タイムアップ秒 = 10
    時刻 = Timer
    Do While Timer - 時刻 < タイムアップ秒
        x = RandBetween(1, 9)
        y = RandBetween(1, 9)
        問題文 = CStyle("前回の結果:%s\n問題:%s+%s=", 結果, x, y)
        結果 = IIf(InputBoxLargeFont(問題文) = x + y, "正解", "不正解")
        問題数 = 問題数 + 1
        If 結果 = "正解" Then 正解数 = 正解数 + 1
    Loop
    MsgBox CStyle("タイムアップ\n\n正解数:%s/%s", 正解数, 問題数)
End Sub

そしてさらに桁数指定が出来るように変更

Sub フラッシュ足し算()
    Const タイムアップ秒 = 10
    Const 桁数 = 2
    
    最小値 = 10 ^ (桁数 - 1) + 1
    最大値 = 10 ^ 桁数 - 1

    時刻 = Timer
    Do While Timer - 時刻 < タイムアップ秒
        x = RandBetween(最小値, 最大値)
        y = RandBetween(最小値, 最大値)
        問題文 = CStyle("前回の結果:%s\n問題:%s+%s=", 結果, x, y)
        結果 = IIf(InputBoxLargeFont(問題文) = x + y, "正解", "不正解")
        問題数 = 問題数 + 1
        If 結果 = "正解" Then 正解数 = 正解数 + 1
    Loop
    MsgBox CStyle("タイムアップ\n\n正解数:%s/%s", 正解数, 問題数)
End Sub

2桁だと10秒で3問くらいしか解けない。。

これでようやく脳トレになりそうだ。

当ブログは、amazon.co.jpを宣伝しリンクすることによってサイトが紹介料を獲得できる手段を提供することを目的に設定されたアフィリエイト宣伝プログラムである、 Amazonアソシエイト・プログラムの参加者です。