【VBA】Quizプログラムを作ってみたよ！

【VBA】Quizマクロ

皆さん、クイズは好きですか？
いきなりこんなこと訊かれても、よほどのクイズ好き以外は返答に困るでしょうけど、取り立てて「嫌い」て言う人もあまりいないと思うので、「こういうマクロも簡単にできちゃうんだね」ぐらいの気分で軽く読み流してください。問題は全て VBA に関するものです。中には少し難しいな問題もあるので、全部正解したら中級以上だと思いますよ。とりあえず、Quizマクロのプロシージャはこんなふうになります。

'[VBA] ランダムにクイズが出題されるプロシージャ

Option Base 1

Sub Quiz()

　　Dim i As Integer
　　Dim q(5) As String
　　Dim a(5) As String
　　Dim mystr(5) As String

　　q(1) = "値が日付かどうかをチェックするのは（　　）関数"
　　q(2) = "配列のインデックス番号の下限値を参照するのは（　　）関数"
　　q(3) = "値渡しで引数を渡すときは（　　）キーワード"
　　q(4) = "グラフの種類を変更するのは（　　）プロパティ"
　　q(5) = "テキストファイルを開くのは（　　）メソッド"

　　a(1) = "IsDate"
　　a(2) = "LBound"
　　a(3) = "ByVal"
　　a(4) = "ChartType"
　　a(5) = "OpenText"

　　ct = 0

　　For i = 1 To 5

　　　　'ユーザーさんに答えを入力してもらいます
　　　　'ただし大文字・小文字は区別しません
　　　　mystr(i) = InputBox(q(i))

　　　　'入力された文字が解答と同じであれば
　　　　If StrComp(a(i), mystr(i), 1) = 0 Then
　　　　　　'正解数に 1 を加えます
　　　　　　ct = ct + 1
　　　　　　MsgBox "正解です！"
　　　　Else
　　　　　　MsgBox "残念！"
　　　　End If

　　Next i

　　'全部で何問正解したかを表示します
　　MsgBox ct & "問正解です"

End Sub

全部で 5 つの問題 q(i) と解答 a(i)、ユーザーさんの入力した解答 mystr(i) を全て配列に入れておいて、a(i) と mystr(i) が等しければ「正解です！」、違っていれば「残念！」と表示されます。その文字列を比較するときに StrComp という少し難しい関数を使っています。というのは、

If a(i) = mystr(i) Then

というように書いてしまうと、大文字と小文字を違うものとして区別してしまいます。このような比較モードを Bynaryモードとよびます。たとえば “IsDate” が正解であるところを、ユーザーさんが “isdate” と入力すると「間違いです！」と判定されてしまうのです。でも VBE (Visual Basic Editor) のコードウィンドウでは小文字で入力したって、大文字にすべきところは自動で大文字に変えてくれるのですから、”isdate” だって正解にしたいところです。さもないと、ユーザーさんが「なんだ、このプログラムは！？」と怒ってしまいます。そこで大文字と小文字を同じものとして扱うために、Textモードで比較する必要があるのですが、そのときに使用するのが StrComp関数なのです。StrComp関数は

StrComp(文字列1, 文字列2 [, 比較モード])

という形式で記述し、[比較モード] に「1」を指定すると、Textモードで文字列を比較し、等しい場合に「0」を返します。上のマクロでは

StrComp(a(i), mystr(i), 1)

と記述して、配列 a(i) と mystr(i) に入っている文字列を Textモードで比較しているわけです。

ChatGPT にも VBA でクイズを出題するマクロを作ってもらいました。
 
[ChatGPT] 以下は、VBAでクイズを出題するマクロの例です。この例では、3つの質問とそれぞれの選択肢が定義されています。マクロは、クイズを出題し、回答を受け取り、正解かどうかを判定する機能を持っています。

Sub QuizMacro()
    '質問と回答のデータを定義する
    Dim questions As Variant
    Dim choices As Variant
    Dim answers As Variant
    
    questions = Array("日本の首都はどこですか？", "1+1はいくつですか？", "最も大きな惑星は何ですか？")
    choices = Array("A. 東京", "B. 大阪", "C. 京都", "A. 1", "B. 2", "C. 3", "A. 地球", "B. 木星", "C. 天王星")
    answers = Array("A", "B", "B")
    
    'クイズを出題する
    Dim i As Integer
    Dim userAnswer As String
    Dim score As Integer
    score = 0
    
    For i = LBound(questions) To UBound(questions)
        MsgBox "【質問" & (i + 1) & "】" & vbCrLf & questions(i) & vbCrLf & choices(i * 3) & vbCrLf & choices(i * 3 + 1) & vbCrLf & choices(i * 3 + 2)
        
        userAnswer = InputBox("回答を入力してください（A, B, Cのいずれか）")
        
        If userAnswer = answers(i) Then
            MsgBox "正解です！"
            score = score + 1
        Else
            MsgBox "不正解です…"
        End If
    Next i
    
    ' 点数を表示する
    MsgBox "クイズ終了！" & vbCrLf & "あなたの点数は " & score & "/" & (UBound(questions) + 1) & " 点です。"
End Sub

QuizMacro を実行すると、3つの質問が順番に表示され、回答を入力するプロンプトが表示されます。回答が正解かどうかを判定し、結果をメッセージボックスで表示します。最後に、正解した問題の数を点数として表示します（注意：この例は簡略化されたクイズの実装です。実際のクイズにはより多くの質問や選択肢を追加することができます。また、回答のバリデーションやエラーハンドリングの追加も検討してください）。