[ExcelVBA] 数あてゲーム

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

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

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

view plainprint?

1. Option Explicit  
2.   
3. Sub TestCode1()  
4.     Randomize  
5.     Debug.Print (Int(Rnd() * 4))  
6. End Sub  

Option Explicit

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

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

view plainprint?

1. Option Explicit  
2.   
3. Sub TestCode2()  
4.     Randomize  
5.     Debug.Print (Int(Rnd() * 1000)) + 1  
6. End Sub  

Option Explicit

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

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

view plainprint?

1. Option Explicit  
2.   
3. Sub MainCode()  
4.     Randomize  
5.     Dim Answer As Integer  
6.     Answer = (Int(Rnd() * 1000)) + 1 '１～１０００の整数  
7. End Sub  

Option Explicit

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

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

view plainprint?

1. Option Explicit  
2.   
3. Sub MainCode()  
4.     Randomize  
5.     Dim Answer As Integer  
6.     Answer = (Int(Rnd() * 1000)) + 1 '１～１０００の整数  
7.       
8.     Dim UserInputData As Integer  
9.     Do  
10.         If UserInputData = Answer Then  
11.             '当たった時の処理  
12.             MsgBox ("正解です")  
13.             Exit Do  
14.         Else  
15.             'はずれた時の処理  
16.             MsgBox ("はずれです" & "[" & Answer & "]")  
17.         End If  
18.     Loop  
19. End Sub  

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にて受け取る

view plainprint?

1. Option Explicit  
2.   
3. Sub MainCode()  
4.     Randomize  
5.     Dim Answer As Integer  
6.     Answer = (Int(Rnd() * 1000)) + 1 '１～１０００の整数  
7.       
8.     Dim UserInputData As Integer  
9.     Do  
10.         UserInputData = InputBox("1～1000の間の整数値を入力してね")  
11.         If UserInputData = Answer Then  
12.             '当たった時の処理  
13.             MsgBox ("正解です")  
14.             Exit Do  
15.         Else  
16.             'はずれた時の処理  
17.             MsgBox ("はずれです" & "[" & Answer & "]")  
18.         End If  
19.     Loop  
20. End Sub  

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内でユーザーの入力値と 答えを比較して大きい場合と小さい場合でメッセージを表示します。

view plainprint?

1. Option Explicit  
2.   
3. Sub MainCode()  
4.     Randomize  
5.     Dim Answer As Integer  
6.     Answer = (Int(Rnd() * 1000)) + 1 '１～１０００の整数  
7.       
8.     Dim UserInputData As Integer  
9.     Do  
10.         UserInputData = InputBox("1～1000の間の整数値を入力してね")  
11.         If UserInputData = Answer Then  
12.             '当たった時の処理  
13.             MsgBox ("正解です")  
14.             Exit Do  
15.         Else  
16.             'はずれた時の処理  
17.             If UserInputData < Answer Then  
18.                 MsgBox ("はずれです" & vbCrLf & _  
19.                         "答えはもっと大きいです！")  
20.             Else  
21.                 MsgBox ("はずれです" & vbCrLf & _  
22.                         "答えはもっと小さいです！")  
23.             End If  
24.         End If  
25.     Loop  
26. End Sub  

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回で終了させるようにしましょう。

view plainprint?

1. Option Explicit  
2.   
3. Sub MainCode()  
4.     Randomize  
5.     Dim GameCount As Integer  
6.     GameCount = 10 '何回でゲーム終了とするか設定する  
7.       
8.     Dim Answer As Integer  
9.     Answer = (Int(Rnd() * 1000)) + 1 '１～１０００の整数  
10.       
11.     Dim UserInputData As Integer  
12.     Do  
13.         UserInputData = InputBox("1～1000の間の整数値を入力してね")  
14.         GameCount = GameCount - 1 '入力後にゲームカウントを減らす  
15.           
16.         If UserInputData = Answer Then  
17.             '当たった時の処理  
18.             MsgBox ("正解です")  
19.             Exit Do  
20.         Else  
21.             ''はずれた時の処理  
22.             'ゲーム続行できるか判定する  
23.             If GameCount = 0 Then  
24.                 MsgBox ("GameOver" & vbCrLf & _  
25.                         "答えは「" & Anwser & "」でした")  
26.                 Exit Do  
27.             End If  
28.               
29.             If UserInputData < Answer Then  
30.                 MsgBox ("はずれです" & vbCrLf & _  
31.                         "答えはもっと大きいです！")  
32.             Else  
33.                 MsgBox ("はずれです" & vbCrLf & _  
34.                         "答えはもっと小さいです！")  
35.             End If  
36.         End If  
37.     Loop  
38. 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("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

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

view plainprint?

1. Option Explicit  
2.   
3. Sub MainCode()  
4.     Randomize  
5.     Dim GameCount As Integer  
6.     GameCount = 10 '何回でゲーム終了とするか設定する  
7.       
8.     Dim Answer As Integer  
9.     Answer = (Int(Rnd() * 1000)) + 1 '１～１０００の整数  
10.       
11.     Dim UserInputData As Integer  
12.     Do  
13.         UserInputData = InputBox("あと" & GameCount & "回答えれます!" & vbCrLf & _  
14.                                  "1～1000の間の整数値を入力してね")  
15.                                    
16.         GameCount = GameCount - 1 '入力後にゲームカウントを減らす  
17.           
18.         If UserInputData = Answer Then  
19.             '当たった時の処理  
20.             MsgBox (Answer & "で正解です！！" & vbCrLf & _  
21.                     10 - GameCount & "回で正解しました")  
22.             Exit Do  
23.         Else  
24.             ''はずれた時の処理  
25.             'ゲーム続行できるか判定する  
26.             If GameCount = 0 Then  
27.                 MsgBox ("GameOver" & vbCrLf & _  
28.                         "答えは「" & Answer & "」でした")  
29.                 Exit Do  
30.             End If  
31.               
32.             If UserInputData < Answer Then  
33.                 MsgBox ("はずれです" & vbCrLf & _  
34.                         "答えはもっと大きいです！" & vbCrLf & _  
35.                         "あと" & GameCount & "回")  
36.             Else  
37.                 MsgBox ("はずれです" & vbCrLf & _  
38.                         "答えはもっと小さいです！" & vbCrLf & _  
39.                         "あと" & GameCount & "回")  
40.             End If  
41.         End If  
42.     Loop  
43. 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型に変換してくれていたので問題がなかったものの もし、ユーザーが数字以外を入力したらどうなるか？ということです。
共にエラーになりますよね。
本来なら入力ミスをミスと捕らえてそのままゲームを進行してもいいのですが今回は必ず何かしらの数字を入力してもらうという形にしてみます。

(完成形)

view plainprint?

1. Option Explicit  
2.   
3. Sub MainCode()  
4.     Randomize  
5.     Dim GameCount As Integer  
6.     GameCount = 10 '何回でゲーム終了とするか設定する  
7.       
8.     Dim Answer As Integer  
9.     Answer = (Int(Rnd() * 1000)) + 1 '１～１０００の整数  
10.       
11.     Dim UserInputData As String 'InputBoxからの値はString型  
12.     Do  
13.         Do '必ず何かしらの数字を入力してもらう  
14.             UserInputData = InputBox("あと" & GameCount & "回答えれます!" & vbCrLf & _  
15.                                      "1～1000の間の整数値を入力してね")  
16.         Loop Until IsNumeric(UserInputData)  
17.           
18.         GameCount = GameCount - 1 '入力後にゲームカウントを減らす  
19.           
20.         If CInt(UserInputData) = Answer Then  
21.             '当たった時の処理  
22.             MsgBox (Answer & "で正解です！！" & vbCrLf & _  
23.                     10 - GameCount & "回で正解しました")  
24.             Exit Do  
25.         Else  
26.             ''はずれた時の処理  
27.             'ゲーム続行できるか判定する  
28.             If GameCount = 0 Then  
29.                 MsgBox ("GameOver" & vbCrLf & _  
30.                         "答えは「" & Answer & "」でした")  
31.                 Exit Do  
32.             End If  
33.               
34.             If CInt(UserInputData) < Answer Then  
35.                 MsgBox ("はずれです" & vbCrLf & _  
36.                         "答えはもっと大きいです！" & vbCrLf & _  
37.                         "あと" & GameCount & "回")  
38.             Else  
39.                 MsgBox ("はずれです" & vbCrLf & _  
40.                         "答えはもっと小さいです！" & vbCrLf & _  
41.                         "あと" & GameCount & "回")  
42.             End If  
43.         End If  
44.     Loop  
45. 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 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] プログラミング問題一覧