[ExcelVBA] 数あてゲーム

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] プログラミング問題一覧

■お題
コンピューターが選んだ数字(１～１０００)を１０回以内に当てるゲーム。答えた際に予想した数字が答えより低かったら「もっと上」逆なら「もっと下」等のヒントを出すこと。

■解答例
まずは、乱数を用いてコンピュータが１～１０００の数字を選ぶところから作り始める。いきなり１～１０００ではなく０～３を出すコードを考えてみる。

Option Explicit

Sub TestCode1()
    Randomize
    Debug.Print (Int(Rnd() * 4))
End Sub

Randomizeについてですが、ExcelVBAではこれを指定しないとRnd関数は、Excelを開く度にに同じ値を返してしまいます。
Rnd関数が0以上１未満の連続する値であることから、それを4倍して整数部だけにすると0以上4未満の整数になるので０～３を出すのは問題なさそう。
次に１～１０００にすることを考える。

Option Explicit

Sub TestCode2()
    Randomize
    Debug.Print (Int(Rnd() * 1000)) + 1
End Sub

同様の考えをすると(Int(Rnd() * 1000)で０～９９９の整数値が得られるので、＋１をしてあげると１～１０００の整数値が得られる。
乱数部分完成。まずは、こんな感じに書いてみる。

Option Explicit

Sub MainCode()
    Randomize
    Dim Answer As Integer
    Answer = (Int(Rnd() * 1000)) + 1 '１～１０００の整数
End Sub

次に、ゲームの流れを考えると･･･
ユーザーが答えを入力する→コンピュータの値と比べる→間違える→ヒントを出す→
ユーザーが答えを入力する→コンピュータの値と比べる→間違える→ヒントを出す→
ユーザーが答えを入力する→コンピュータの値と比べる→間違える→ヒントを出す→
ユーザーが答えを入力する→コンピュータの値と比べる→正解する
という流れを見るとループで上記部分を作ればよさそう。そして、コンピュータの値と比べる行為が１サイクルのうち途中に 来ているのでループ文の最初の部分(Doのすぐ後)に判定をするわけにも最後の部分(Loopのすぐ後)で判定するわけにもいかない。 よって、途中にIf文でユーザー入力値と比較して正解していればExit Doでループを抜けるとよさそう。

Option Explicit

Sub MainCode()
    Randomize
    Dim Answer As Integer
    Answer = (Int(Rnd() * 1000)) + 1 '１～１０００の整数
    
    Dim UserInputData As Integer
    Do
        If UserInputData = Answer Then
            '当たった時の処理
            MsgBox ("正解です")
            Exit Do
        Else
            'はずれた時の処理
            MsgBox ("はずれです" & "[" & Answer & "]")
        End If
    Loop
End Sub

ひとまず、テストすることを考えて間違ってたら答えを表示するようにしました。
次に、ユーザーから予想値をInputBoxにて受け取る

Option Explicit

Sub MainCode()
    Randomize
    Dim Answer As Integer
    Answer = (Int(Rnd() * 1000)) + 1 '１～１０００の整数
    
    Dim UserInputData As Integer
    Do
        UserInputData = InputBox("1～1000の間の整数値を入力してね")
        If UserInputData = Answer Then
            '当たった時の処理
            MsgBox ("正解です")
            Exit Do
        Else
            'はずれた時の処理
            MsgBox ("はずれです" & "[" & Answer & "]")
        End If
    Loop
End Sub

ここまでで実際に動かしてチェックしてみることにします。
どうやら問題なさそうです。
あとは、１０回でゲームを終了させる部分と、間違っていた時のヒントを表示する部分を作ります。
まずは、ヒント部分から。間違ってたらヒントを出すわけなので、IF文のElse内でユーザーの入力値と 答えを比較して大きい場合と小さい場合でメッセージを表示します。

Option Explicit

Sub MainCode()
    Randomize
    Dim Answer As Integer
    Answer = (Int(Rnd() * 1000)) + 1 '１～１０００の整数
    
    Dim UserInputData As Integer
    Do
        UserInputData = InputBox("1～1000の間の整数値を入力してね")
        If UserInputData = Answer Then
            '当たった時の処理
            MsgBox ("正解です")
            Exit Do
        Else
            'はずれた時の処理
            If UserInputData < Answer Then
                MsgBox ("はずれです" & vbCrLf & _
                        "答えはもっと大きいです！")
            Else
                MsgBox ("はずれです" & vbCrLf & _
                        "答えはもっと小さいです！")
            End If
        End If
    Loop
End Sub

後は、10回で終了させるようにしましょう。

Option Explicit

Sub MainCode()
    Randomize
    Dim GameCount As Integer
    GameCount = 10 '何回でゲーム終了とするか設定する
    
    Dim Answer As Integer
    Answer = (Int(Rnd() * 1000)) + 1 '１～１０００の整数
    
    Dim UserInputData As Integer
    Do
        UserInputData = InputBox("1～1000の間の整数値を入力してね")
        GameCount = GameCount - 1 '入力後にゲームカウントを減らす
        
        If UserInputData = Answer Then
            '当たった時の処理
            MsgBox ("正解です")
            Exit Do
        Else
            ''はずれた時の処理
            'ゲーム続行できるか判定する
            If GameCount = 0 Then
                MsgBox ("GameOver" & vbCrLf & _
                        "答えは「" & Anwser & "」でした")
                Exit Do
            End If
            
            If UserInputData < Answer Then
                MsgBox ("はずれです" & vbCrLf & _
                        "答えはもっと大きいです！")
            Else
                MsgBox ("はずれです" & vbCrLf & _
                        "答えはもっと小さいです！")
            End If
        End If
    Loop
End Sub

ひとまず、最低限の仕様は、満たしてますね。ただし、これだとあと何回間違えると おしまいなのかとかわからないので、もうちょっとゲームらしく必要な情報を与えることにします。

Option Explicit

Sub MainCode()
    Randomize
    Dim GameCount As Integer
    GameCount = 10 '何回でゲーム終了とするか設定する
    
    Dim Answer As Integer
    Answer = (Int(Rnd() * 1000)) + 1 '１～１０００の整数
    
    Dim UserInputData As Integer
    Do
        UserInputData = InputBox("あと" & GameCount & "回答えれます!" & vbCrLf & _
                                 "1～1000の間の整数値を入力してね")
                                 
        GameCount = GameCount - 1 '入力後にゲームカウントを減らす
        
        If UserInputData = Answer Then
            '当たった時の処理
            MsgBox (Answer & "で正解です！！" & vbCrLf & _
                    10 - GameCount & "回で正解しました")
            Exit Do
        Else
            ''はずれた時の処理
            'ゲーム続行できるか判定する
            If GameCount = 0 Then
                MsgBox ("GameOver" & vbCrLf & _
                        "答えは「" & Answer & "」でした")
                Exit Do
            End If
            
            If UserInputData < Answer Then
                MsgBox ("はずれです" & vbCrLf & _
                        "答えはもっと大きいです！" & vbCrLf & _
                        "あと" & GameCount & "回")
            Else
                MsgBox ("はずれです" & vbCrLf & _
                        "答えはもっと小さいです！" & vbCrLf & _
                        "あと" & GameCount & "回")
            End If
        End If
    Loop
End Sub

MsgBox内を調整してみました。
完成
と言いたいところですが、二つ問題があります。
共にInputBox関数の話です。
一つは、InputBoxで値が入力されずキャンセルもしくは右上の×印を押されたらどうなるか？
もう一つは、InputBoxの返す値の型です。InputBox自体文字列を入力することも考えると返ってくる値の型はStringです。
たまたま今回は数字しか入力していないことと、内部的にInteger型に変換してくれていたので問題がなかったものの もし、ユーザーが数字以外を入力したらどうなるか？ということです。
共にエラーになりますよね。
本来なら入力ミスをミスと捕らえてそのままゲームを進行してもいいのですが今回は必ず何かしらの数字を入力してもらうという形にしてみます。

(完成形)

Option Explicit

Sub MainCode()
    Randomize
    Dim GameCount As Integer
    GameCount = 10 '何回でゲーム終了とするか設定する
    
    Dim Answer As Integer
    Answer = (Int(Rnd() * 1000)) + 1 '１～１０００の整数
    
    Dim UserInputData As String 'InputBoxからの値はString型
    Do
        Do '必ず何かしらの数字を入力してもらう
            UserInputData = InputBox("あと" & GameCount & "回答えれます!" & vbCrLf & _
                                     "1～1000の間の整数値を入力してね")
        Loop Until IsNumeric(UserInputData)
        
        GameCount = GameCount - 1 '入力後にゲームカウントを減らす
        
        If CInt(UserInputData) = Answer Then
            '当たった時の処理
            MsgBox (Answer & "で正解です！！" & vbCrLf & _
                    10 - GameCount & "回で正解しました")
            Exit Do
        Else
            ''はずれた時の処理
            'ゲーム続行できるか判定する
            If GameCount = 0 Then
                MsgBox ("GameOver" & vbCrLf & _
                        "答えは「" & Answer & "」でした")
                Exit Do
            End If
            
            If CInt(UserInputData) < Answer Then
                MsgBox ("はずれです" & vbCrLf & _
                        "答えはもっと大きいです！" & vbCrLf & _
                        "あと" & GameCount & "回")
            Else
                MsgBox ("はずれです" & vbCrLf & _
                        "答えはもっと小さいです！" & vbCrLf & _
                        "あと" & GameCount & "回")
            End If
        End If
    Loop
End Sub

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] プログラミング問題一覧